Merge branch 'master' of github.com:circuithub/rel8 into arbitrary-queries

.github/workflows/build.yaml

@@ -0,0 +1,25 @@
+name: Build
+on: [push, pull_request, release]
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v2.3.4
+      with:
+          persist-credentials: false
+          submodules: true
+
+    - uses: cachix/install-nix-action@v12
+      with:
+        nix_path: nixpkgs=channel:nixos-unstable
+        extra_nix_config: |
+          trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=
+          substituters = https://cache.nixos.org/ https://hydra.iohk.io
+
+    - uses: cachix/cachix-action@v8
+      with:
+        name: rel8
+        authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
+
+    - run: nix-build -A hsPkgs.rel8.components.library
+    - run: nix-build -A hsPkgs.rel8.checks.tests

Doctest.hs

@@ -1,53 +0,0 @@
-{-# language BlockArguments #-}
-{-# language OverloadedStrings #-}
-
-module Main where
-
--- base
-import Control.Exception ( bracket, throwIO )
-import Data.Foldable ( traverse_ )
-import System.Environment ( lookupEnv, setEnv )
-
--- base-compat
-import System.Environment.Compat ( unsetEnv )
-
--- bytestring
-import Data.ByteString.Char8 ( unpack )
-
--- doctest
-import Test.DocTest ( doctest )
-
--- hasql
-import Hasql.Connection ( acquire, release )
-import Hasql.Session ( run, sql )
-
--- rel8
-import Build_doctests ( flags, module_sources, pkgs )
-
--- tmp-postgres
-import Database.Postgres.Temp ( toConnectionString, verboseConfig, with, withConfig )
-
-
-main :: IO ()
-main = do
-  nixGhcLibdir <- lookupEnv "NIX_GHC_LIBDIR"
-  unsetEnv "GHC_ENVIRONMENT"
-  either throwIO return =<< with \db -> do
-    setEnv "TEST_DATABASE_URL" (unpack (toConnectionString db))
-    bracket (either (error . show) return =<< acquire (toConnectionString db)) release \conn -> do
-      flip run conn do
-        sql "create table author ( author_id serial primary key, name text not null, url text )"
-        sql "create table project ( author_id int not null references author (author_id), name text not null )"
-
-        sql "insert into author ( name, url ) values ( 'Ollie', 'https://ocharles.org.uk' )"
-        sql "insert into author ( name, url ) values ( 'Bryan O''Sullivan', null )"
-        sql "insert into author ( name, url ) values ( 'Emily Pillmore', 'https://cohomolo.gy' )"
-        sql "insert into project ( author_id, name ) values ( 1, 'rel8' )"
-        sql "insert into project ( author_id, name ) values ( 2, 'aeson' )"
-        sql "insert into project ( author_id, name ) values ( 2, 'text' )"
-
-    doctest (args nixGhcLibdir)
-
-  where
-    args nixGhcLibdir =
-      flags ++ pkgs ++ foldMap (\x -> ["-package-db" <> x <> "/package.conf.d"]) nixGhcLibdir ++ module_sources

README.md

@@ -0,0 +1,13 @@
+# Welcome!
+
+Welcome to Rel8! Rel8 is a Haskell library for interacting with PostgreSQL databases, built on top of the fantastic Opaleye library.
+
+The main objectives of Rel8 are:
+
+* *Conciseness*: Users using Rel8 should not need to write boiler-plate code. By using expressive types, we can provide sufficient information for the compiler to infer code whenever possible.
+
+* *Inferrable*: Despite using a lot of type level magic, Rel8 aims to have excellent and predictable type inference.
+
+* *Familiar*: writing Rel8 queries should feel like normal Haskell programming.
+
+For more details, check out the [official documentation](https://rel8.readthedocs.io/en/latest/).

Setup.hs

@@ -1,6 +0,0 @@
-module Main where
-
-import Distribution.Extra.Doctest (defaultMainWithDoctests)
-
-main :: IO ()
-main = defaultMainWithDoctests "doctests"

cabal.project

@@ -1 +1,6 @@
 packages: .
+
+allow-newer: generic-monoid:base
+allow-newer: cryptohash-sha1:base
+allow-newer: cryptohash-md5:base
+allow-newer: entropy:Cabal

cabal.project.haskell-nix

@@ -0,0 +1,10 @@
+-- Haskell.nix overrides. We don't put these in cabal.project, because Cabal
+-- will interpret them as local packages, and try to build them when we cabal
+-- build. The only reason we have to specify these is for Haskell.nix to know to
+-- override these packages by fetching them rather than using Hackage.
+
+source-repository-package
+  type: git
+  location: git://github.com/galenhuntington/data-serializer
+  tag: 070d681f97b705f47716e13b646512140524f940
+  --sha256: 198g99ksglnc7c45sjm2xyay1m6hfj4afkp3sksdss5w5abp543f

default.nix

@@ -5,7 +5,7 @@ let
 
   nixpkgsArgs = haskellNix.nixpkgsArgs;
 
-  compiler-nix-name = "ghc8103";
+  compiler-nix-name = "ghc8104";
 
   pkgs = import nixpkgsSrc nixpkgsArgs;
 
@@ -13,6 +13,8 @@ in
 pkgs.haskell-nix.project {
   inherit compiler-nix-name;
 
+  cabalProjectLocal = builtins.readFile ./cabal.project.haskell-nix;
+
   src = pkgs.haskell-nix.haskellLib.cleanGit {
     name = "rel8";
     src = ./.;

docs/Makefile

@@ -0,0 +1,19 @@
+# Minimal makefile for Sphinx documentation
+#
+
+# You can set these variables from the command line.
+SPHINXOPTS    =
+SPHINXBUILD   = sphinx-build
+SOURCEDIR     = .
+BUILDDIR      = _build
+
+# Put it first so that "make" without argument is like "make help".
+help:
+	@$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)
+
+.PHONY: help Makefile
+
+# Catch-all target: route all unknown targets to Sphinx using the new
+# "make mode" option.  $(O) is meant as a shortcut for $(SPHINXOPTS).
+%: Makefile
+	@$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

docs/conf.py

@@ -0,0 +1,32 @@
+import sys
+import os
+import sphinx_rtd_theme
+
+# Support for :base-ref:, etc.
+sys.path.insert(0, os.path.abspath('.'))
+
+version = "1.0.0"
+
+extensions = ['sphinx.ext.extlinks', 'sphinx.ext.todo']
+
+templates_path = ['_templates']
+source_suffix = '.rst'
+source_encoding = 'utf-8-sig'
+master_doc = 'index'
+
+project = u'Rel8'
+copyright = u'2021 CircuitHub'
+release = version  
+
+highlight_language = 'haskell'
+primary_domain = 'haskell'
+
+exclude_patterns = ['.build', "*.gen.rst"]
+
+# on_rtd is whether we are on readthedocs.org, this line of code grabbed from docs.readthedocs.org
+on_rtd = os.environ.get('READTHEDOCS', None) == 'True'
+
+if not on_rtd:  # only import and set the theme if we're building docs locally
+    import sphinx_rtd_theme
+    html_theme = 'sphinx_rtd_theme'
+    html_theme_path = [sphinx_rtd_theme.get_html_theme_path()]

docs/cookbook.rst

@@ -0,0 +1,167 @@
+Cookbook
+========
+
+This cookbook exists to help you easily form Rel8 queries. It's main purpose is
+to help those familiar with SQL to translate their queries into Rel8
+``Query``\s.
+
+``SELECT * FROM table``
+-----------------------
+
+To select from a table, use ``each``.
+
+Inner joins
+-----------
+
+To perform an inner join against two queries, use ``where_`` with a join
+condition. For example, the following SQL:
+
+.. code-block:: sql
+
+  SELECT * FROM table_a JOIN table_b ON table_a.x = table_b.y
+
+can be written as::
+
+  myQuery = do
+    a <- each tableA
+    b <- each tableB
+    where_ $ tableAX a ==. tableBY b
+
+Left (outer) joins
+------------------
+
+A ``LEFT JOIN`` query is performed by using ``optional``.
+
+For example, the query:
+
+.. code-block:: sql
+
+  SELECT * FROM table_a LEFT JOIN table_b ON table_a.x = table_b.y
+
+can be written as::
+
+  myQuery = do
+    a <- each tableA
+
+    maybeB <- optional do
+      b <- each tableB
+      where_ $ tableAX a ==. tableBY b
+
+    return (a, maybeB)
+
+Note that ``maybeB`` here will be a ``MaybeTable``, which is the Rel8
+``Query``-equivalent of ``Maybe``. This allows you to observe if a left join
+has succeeded or failed.
+
+Ordering results
+----------------
+
+A ``Query`` by default has no ordering - just like in SQL. If you rows back in
+a certain order, you can use ``orderBy`` with an ``Order``.
+
+For example, the query:
+
+.. code-block:: sql
+
+  SELECT * FROM my_table ORDER BY my_table.id ASC, my_table.x DESC NULLS FIRST
+
+can be written as::
+
+  myQuery = 
+    orderBy (mconcat [ myTableId >$< asc, myTableX >$< nullsFirst desc ]) $
+    each myTableSchema
+
+Note that we use ``>$<`` (from ``Data.Functor.Contravariant``) to select table
+columns, and we can use `mconcat` to combine orderings.
+
+If all columns of a table have an ordering, you can also use ``ascTable`` and
+``descTable``. For example::
+  
+  myQuery = orderBy ascTable $ each myTableSchema
+
+Aggregations
+------------
+
+Aggregations in Rel8 work by using ``aggregate``, which takes a ``Query
+(Aggregate a)`` and gives you back a ``Query a``.
+
+The following query:
+
+.. code-block:: sql
+
+  SELECT sum(foo), count(distinct bar) FROM table_a
+
+can be written as::
+
+  myQuery = aggregate do
+    a <- each tableA
+    return $ liftF2 (,) (sum (foo a)) (countDistinct (bar a))
+
+where ``liftF2`` comes from ``Data.Functor.Apply`` from the ``semigroupoids``
+library.
+
+Combining aggregations
+----------------------
+
+As ``Aggregate`` is an instance of ``Apply`` (which is very similar to
+``Applicative``), individual aggregations can be combined. For example, one way
+to take the average rating would be to write the query:
+
+.. code-block:: sql
+
+  SELECT sum(rating.score) / count(rating.score) FROM rating
+
+In Rel8, we can write this as::
+
+  myQuery = aggregate do
+    rating <- each ratingSchema
+    return $ liftF2 (/) (sum (score rating)) (count (score rating))
+
+You can also use ``RebindableSyntax`` and ``ApplicativeDo``::
+  
+  {-# language ApplicativeDo, RebindableSyntax #-}
+
+  import Data.Functor.Apply ((<.>))
+
+  myQuery = aggregate do
+    rating <- each ratingSchema
+    return do
+      scoreSum        <- sum (score rating)
+      numberOfRatings <- count (score rating)
+      return (scoreSum / numberOfRatings)
+    where (<*>) = (<.>)
+
+For large aggregations, this can often make queries easier to read.
+
+Tree-like queries
+-----------------
+
+Rel8 has a fairly unique feature in that it's able to return not just lists of
+rows, but can also return *tree*\s.
+
+To understand what this means, we'll consider a small example query for blog
+posts. We want our query to return:
+
+1. The latest 5 blog posts.
+2. For each blog post, all tags.
+3. For each blog post, the latest 3 comments.
+
+In Rel8, we can write this query as::
+
+  latestBlogPosts = do
+    post <- each postSchema
+
+    tags <- aggregate do
+      tag <- each tagSchema
+      where_ (tagPostId tag ==. postId post)
+      return (listAgg (tagName tag))
+
+    latestComments <- 
+      many $ 
+      limit 3 $ 
+      orderBy (commentCreatedAt >$< desc) do
+        comment <- each commentSchema
+        where_ (commentPostId comment ==. postId post)
+
+    return (post, tags, latestComments)
+

docs/index.rst

@@ -0,0 +1,38 @@
+Welcome to Rel8!
+================================
+
+Welcome to Rel8! Rel8 is a Haskell library for interacting with PostgreSQL
+databases, built on top of the fantastic `Opaleye
+<https://hackage.haskell.org/package/opaleye>`_ library.
+
+The main objectives of Rel8 are:
+
+* *Conciseness*: Users using Rel8 should not need to write boiler-plate code.
+  By using expressive types, we can provide sufficient information for the
+  compiler to infer code whenever possible.
+
+* *Inferrable*: Despite using a lot of type level magic, Rel8 aims to have
+  excellent and predictable type inference.
+
+* *Familiar*: writing Rel8 queries should feel like normal Haskell programming.
+
+.. toctree::
+   :maxdepth: 3
+   :caption: Contents:
+
+   tutorial
+   cookbook
+
+
+More Resources
+==============
+
+* The `Haskell API documentation <https://hackage.haskell.org/package/rel8>`_
+  describes how individual functions are types are to be used.
+
+* If you have a question about how to use Rel8, feel free to open a `GitHub
+  discussion <https://github.com/circuithub/rel8/discussions>`_.
+
+* If you think you've found a bug, confusing behavior, or have a feature
+  request, please raise an issue at `Rel8's issue tracker
+  <https://github.com/circuithub/rel8>`_. 

docs/requirements.txt

@@ -0,0 +1,3 @@
+sphinx == 3.1.*
+sphinx_rtd_theme
+

docs/tutorial.rst

@@ -0,0 +1,368 @@
+.. highlight:: haskell
+
+Getting Started
+===============
+
+In this section, we'll take a look at using Rel8 to work with a small database
+for Haskell packages. We'll take a look at idiomatic usage of Rel8, mapping
+tables to Haskell, and then look at writing some simple queries. 
+
+Before we get started, we'll be using the following language extensions and
+imports throughout this guide::
+
+  {-# language -XBlockArguments #-}
+  {-# language -XDeriveAnyClass #-}
+  {-# language -XDeriveGeneric #-}
+  {-# language -XDerivingStrategies #-}
+  {-# language -XDerivingVia #-}
+  {-# language -XDuplicateRecordFields #-}
+  {-# language -XGeneralizedNewtypeDeriving #-}
+  {-# language -XOverloadedStrings #-}
+  {-# language -XStandaloneDeriving #-}
+  {-# language -XTypeApplications #-}
+  {-# language -XTypeFamilies #-}
+
+  import Prelude
+
+The Example Schema
+------------------
+
+Before we start writing any Haskell, let's take a look at the schema we'll work
+with. The `author` table has three columns:
+
++-----------------+-------------+----------+
+| Column Name     | Type        | Nullable |
++=================+=============+==========+
+| ``author_id``   | ``integer`` | not null |
++-----------------+-------------+----------+
+| ``name``        | ``text``    | not null |
++-----------------+-------------+----------+
+| ``url``         | ``text``    |          |
++-----------------+-------------+----------+
+
+and the `project` table has two:
+
++-----------------+-------------+----------+
+| Column Name     | Type        | Nullable |
++=================+=============+==========+
+| ``author_id``   | ``integer`` | not null |
++-----------------+-------------+----------+
+| ``name``        | ``text``    | not null |
++-----------------+-------------+----------+
+
+A ``project`` always has an ``author``, but not all ``author``\s have projects.
+Each ``author`` has a name and (maybe) an associated website, and each project
+has a name.
+
+Mapping Schemas to Haskell
+--------------------------
+
+Now that we've seen our schema, we can begin writing a mapping in Rel8. The
+idiomatic way to map a table is to use a record that is parameterised what Rel8
+calls an *interpretation functor*, and to define each field with ``Column``.
+For this type to be usable with Rel8 we need it to be an instance of
+``Rel8able``, which can be derived with a combination of ``DeriveAnyClass`` and
+``DeriveGeneric`` language extensions.
+
+Following these steps for ``author``, we have::
+
+  data Author f = Author
+    { authorId :: Column f Int64
+    , name     :: Column f Text
+    , url      :: Column f (Maybe Text)
+    } 
+    deriving stock (Generic)
+    deriving anyclass (Rel8able)
+
+This is a perfectly reasonable definition, but cautious readers might notice a
+problem - in particular, with the type of the ``authorId`` field.  While
+``Int64`` is correct, it's not the best type. If we had other identifier types
+in our project, it would be too easy to accidentally mix them up and create
+nonsensical joins. As Haskell programmers, we often solve this problem by
+creating ``newtype`` wrappers, and we can also use this technique with Rel8::
+
+  newtype AuthorId = AuthorId { toInt64 :: Int64 } 
+    deriving newtype (DBEq, DBType, Eq, Show)
+
+Now we can write our final schema mapping. First, the ``author`` table::
+
+  data Author f = Author
+    { authorId   :: Column f AuthorId
+    , authorName :: Column f Text
+    , authorUrl  :: Column f (Maybe Text)
+    } 
+    deriving stock (Generic)
+    deriving anyclass (Rel8able)
+
+And similarly, the ``project`` table::
+
+  data Project f = Project
+    { projectAuthorId :: Column f AuthorId
+    , projectName     :: Column f Text
+    } 
+    deriving stock (Generic)
+    deriving anyclass (Rel8able
+
+To show query results in this documentation, we'll also need ``Show`` instances:
+Unfortunately these definitions look a bit scary, but they are essentially just
+``deriving (Show)``::
+
+  deriving stock instance f ~ Identity => Show (Author f)
+  deriving stock instance f ~ Identity => Show (Project f)
+
+These data types describe the structural mapping of the tables, but we also
+need to specify a ``TableSchema`` for each table. A ``TableSchema`` contains
+the name of the table and the name of all columns in the table, which will
+ultimately allow us to ``SELECT`` and ``INSERT`` rows for these tables.
+
+To define a ``TableSchema``, we just need to fill construct appropriate
+``TableSchema`` values. When it comes to the ``tableColumns`` field, we
+construct values of our data types above, and set each field to the name of the
+column that it maps to.
+
+First, ``authorSchema`` describes the column names of the ``author`` table when
+associated with the ``Author`` type::
+
+  authorSchema :: TableSchema (Author Name)
+  authorSchema = TableSchema
+    { tableName = "author"
+    , tableSchema = Nothing
+    , tableColumns = Author
+        { authorId = "author_id"
+        , authorName = "name"
+        , authorUrl = "url"
+        }
+    }
+
+And likewise for ``project`` and ``Project``::
+
+  projectSchema :: TableSchema (Project Name)
+  projectSchema = TableSchema
+    { tableName = "project"
+    , tableSchema = Nothing
+    , tableColumns = Project
+        { projectAuthorId = "author_id"
+        , projectName = "name"
+        }
+    }
+
+
+.. note::
+
+  You might be wondering why this information isn't in the definitions of
+  ``Author`` and ``Project`` above. Rel8 decouples ``TableSchema`` from the data
+  types themselves, as not all tables you define will necessarily have a schema.
+  For example, Rel8 allows you to define helper types to simplify the types of
+  queries - these tables only exist at query time, but there is no corresponding
+  base table. We'll see more on this idea later!
+
+With these table definitions, we can now start writing some queries!
+
+Writing Queries
+---------------
+
+Simple Queries
+~~~~~~~~~~~~~~
+
+First, we'll take a look at ``SELECT`` statements - usually the bulk of most
+database heavy applications.
+
+In Rel8, ``SELECT`` statements are built using the ``Query`` monad. You can
+think of this monad like the ordinary ``[]`` (List) monad - but this isn't
+required knowledge. 
+
+To start, we'll look at one of the simplest queries possible - a basic ``SELECT
+* FROM`` statement. To select all rows from a table, we use ``each``, and
+supply a ``TableSchema``. So to select all ``project`` rows, we can write::
+
+  >>> :t each projectSchema
+  each projectSchema :: Query (Project Expr)
+
+Notice that ``each`` gives us a ``Query`` that yields ``Project Expr`` rows. To
+see what this means, let's have a look at a single field of a ``Project Expr``::
+
+  >>> let aProjectExpr = undefined :: Project Expr
+  >>> :t projectAuthorId aProjectExpr
+  projectAuthorId aProjectExpr :: Expr AuthorId
+
+Recall we defined ``projectAuthorId`` as ``Column f AuthorId``. Now we have
+``f`` is ``Expr``, and ``Column Expr AuthorId`` reduces to ``Expr AuthorId``.
+We'll see more about ``Expr`` soon, but you can think of ``Expr a`` as "SQL
+expressions of type ``a``\".
+
+To execute this ``Query``, we pass it to ``select``::
+
+  >>> :t select c (each projectSchema)
+  select c (each projectSchema) :: MonadIO m => m [Project Identity]
+
+When we ``select`` things containing ``Expr``s, Rel8 builds a new response
+table with the ``Identity`` interpretation. This means you'll get back plain
+Haskell values. Studying ``projectAuthorId`` again, we have::
+
+  >>> let aProjectIdentity = undefined :: Project Identity
+  >>> :t projectAuthorId aProjectIdentity
+  projectAuthorId aProjectIdentity :: AuthorId
+
+Here ``Column Identity AuthorId`` reduces to just ``AuthorId``, with no
+wrappping type at all.
+
+Putting this all together, we can run our first query::
+
+  >>> select c (each projectSchema) >>= mapM_ print
+  Project {projectAuthorId = 1, projectName = "rel8"}
+  Project {projectAuthorId = 2, projectName = "aeson"}
+  Project {projectAuthorId = 2, projectName = "text"}
+
+We now know that ``each`` is the equivalent of a ``SELECT *`` query, but
+sometimes we're only interested in a subset of the columns of a table. To
+restrict the returned columns, we can specify a projection by using ``Query``\s
+``Functor`` instance::
+
+  >>> select c $ projectName <$> each projectSchema
+  ["rel8","aeson","text"]
+
+Joins
+~~~~~
+
+Another common operation in relational databases is to take the ``JOIN`` of
+multiple tables. Rel8 doesn't have a specific join operation, but we can
+recover the functionality of a join by selecting all rows of two tables, and
+then using ``where_`` to filter them.
+
+To see how this works, first let's look at taking the product of two tables.
+We can do this by simply calling ``each`` twice, and then returning a tuple of
+their results::
+
+  >>> :{
+  mapM_ print =<< select c do
+    author  <- each authorSchema
+    project <- each projectSchema
+    return (projectName project, authorName author)
+  :}
+  ("rel8","Ollie")
+  ("rel8","Bryan O'Sullivan")
+  ("rel8","Emily Pillmore")
+  ("aeson","Ollie")
+  ("aeson","Bryan O'Sullivan")
+  ("aeson","Emily Pillmore")
+  ("text","Ollie")
+  ("text","Bryan O'Sullivan")
+  ("text","Emily Pillmore")
+
+This isn't quite right, though, as we have ended up pairing up the wrong
+projects and authors. To fix this, we can use ``where_`` to restrict the
+returned rows. We could write::
+
+  select c $ do
+    author  <- each authorSchema
+    project <- each projectSchema
+    where_ $ projectAuthorId project ==. authorId author
+    return (project, author)
+
+but doing this every time you need a join can obscure the meaning of the
+query you're writing. A good practice is to introduce specialised functions
+for the particular joins in your database. In our case, this would be::
+
+  projectsForAuthor :: Author Expr -> Query (Project Expr)
+  projectsForAuthor a = each projectSchema >>= filter \p ->
+    projectAuthorId p ==. authorId a
+
+Our final query is then::
+
+  >>> :{
+  mapM_ print =<< select c do
+    author  <- each authorSchema
+    project <- projectsForAuthor author
+    return (projectName project, authorName author)
+  :}
+  ("rel8","Ollie")
+  ("aeson","Bryan O'Sullivan")
+  ("text","Bryan O'Sullivan")
+
+Left Joins
+~~~~~~~~~~
+
+Rel8 is also capable of performing ``LEFT JOIN``\s. To perform ``LEFT JOIN``\s,
+we follow the same approach as before, but use the ``optional`` query
+transformer to allow for the possibility of the join to fail.
+
+In our test database, we can see that there's another author who we haven't
+seen yet::
+
+  >>> select c $ authorName <$> each authorSchema
+  ["Ollie","Bryan O'Sullivan","Emily Pillmore"]
+
+Emily wasn't returned in our earlier query because - in our database - she
+doesn't have any registered projects. We can account for this partiality in our
+original query by wrapping the ``projectsForAuthor`` call with ``optional``::
+
+  >>> :{
+  mapM_ print =<< select c do
+    author   <- each authorSchema
+    mproject <- optional $ projectsForAuthor author
+    return (authorName author, projectName <$> mproject)
+  :}
+  ("Ollie",Just "rel8")
+  ("Bryan O'Sullivan",Just "aeson")
+  ("Bryan O'Sullivan",Just "text")
+  ("Emily Pillmore",Nothing)
+
+
+Aggregation
+~~~~~~~~~~~
+
+Aggregations are operations like ``sum`` and ``count`` - operations that reduce
+multiple rows to single values. To perform aggregations in Rel8, we can use the
+``aggregate`` function, which takes a ``Query`` of aggregated expressions, runs
+the aggregation, and returns aggregated rows.
+
+To start, let's look at a simple aggregation that tells us how many projects
+exist::
+
+  >>> error "TODO"
+
+Rel8 is also capable of aggregating multiple rows into a single row by
+concatenating all rows as a list. This aggregation allows us to break free of
+the row-orientated nature of SQL and write queries that return tree-like
+structures. Earlier we saw an example of returning authors with their projects,
+but the query didn't do a great job of describing the one-to-many relationship
+between authors and their projects.
+
+Let's look again at a query that returns authors and their projects, and
+focus on the /type/ of that query::
+
+  projectsForAuthor a = each projectSchema >>= filter \p ->
+    projectAuthorId p ==. authorId a
+
+  let authorsAndProjects = do
+        author  <- each authorSchema
+        project <- projectsForAuthor author
+        return (author, project)
+        where
+
+  >>> :t select c authorsAndProjects
+  select c authorsAndProjects 
+    :: MonadIO m => m [(Author Identity, Project Identity)]
+
+
+Our query gives us a single list of pairs of authors and projects. However,
+with our domain knowledge of the schema, this isn't a great type - what we'd
+rather have is a list of pairs of authors and /lists/ of projects. That is,
+what we'd like is::
+
+  [(Author Identity, [Project Identity])]
+
+This would be a much better type! Rel8 can produce a query with this type by
+simply wrapping the call to ``projectsForAuthor`` with either ``some`` or
+``many``.  Here we'll use ``many``, which allows for the possibility of an
+author to have no projects::
+
+  >>> :{
+  mapM_ print =<< select c do
+    author       <- each authorSchema
+    projectNames <- many $ projectName <$> projectsForAuthor author
+    return (authorName author, projectNames)
+  :}
+  ("Ollie",["rel8"])
+  ("Bryan O'Sullivan",["aeson","text"])
+  ("Emily Pillmore",[])

jobs.nix

@@ -1,5 +0,0 @@
-let rel8 = (import ./.).hsPkgs.rel8;
-in { 
-  rel8 = rel8.components.library; 
-  tests = rel8.checks.tests; 
-}

nix/sources.json

@@ -1,14 +1,14 @@
 {
     "haskell.nix": {
-        "branch": "circuithub",
+        "branch": "master",
         "description": "Alternative Haskell Infrastructure for Nixpkgs",
         "homepage": "https://input-output-hk.github.io/haskell.nix",
-        "owner": "circuithub",
+        "owner": "input-output-hk",
         "repo": "haskell.nix",
-        "rev": "2902f9b49484a87afb0e1a33b1d88a2c7b8ca0a0",
-        "sha256": "0a01g5b46z5yaf2mnl415hc4lciwiyqhj22qhgwgwd261w4068iy",
+        "rev": "486de5bfd4e7a93d999dc09969cb1278b9a43f30",
+        "sha256": "12mal6p6z946z1w0knv04dkhpjmyqlaccmkf7skv23bf8iqg6gaz",
         "type": "tarball",
-        "url": "https://github.com/circuithub/haskell.nix/archive/2902f9b49484a87afb0e1a33b1d88a2c7b8ca0a0.tar.gz",
+        "url": "https://github.com/input-output-hk/haskell.nix/archive/486de5bfd4e7a93d999dc09969cb1278b9a43f30.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "niv": {
@@ -17,10 +17,10 @@
         "homepage": "https://github.com/nmattia/niv",
         "owner": "nmattia",
         "repo": "niv",
-        "rev": "ba57d5a29b4e0f2085917010380ef3ddc3cf380f",
-        "sha256": "1kpsvc53x821cmjg1khvp1nz7906gczq8mp83664cr15h94sh8i4",
+        "rev": "af958e8057f345ee1aca714c1247ef3ba1c15f5e",
+        "sha256": "1qjavxabbrsh73yck5dcq8jggvh3r2jkbr6b5nlz5d9yrqm9255n",
         "type": "tarball",
-        "url": "https://github.com/nmattia/niv/archive/ba57d5a29b4e0f2085917010380ef3ddc3cf380f.tar.gz",
+        "url": "https://github.com/nmattia/niv/archive/af958e8057f345ee1aca714c1247ef3ba1c15f5e.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "nixpkgs": {
@@ -29,22 +29,10 @@
         "homepage": null,
         "owner": "nixos",
         "repo": "nixpkgs",
-        "rev": "6e7f25001fe6874f7ae271891f709bbf50a22c45",
-        "sha256": "1x04j4351pqiqbpkq6g308mxcvb5aqnwv8l2vmlxkgvq5phzky7z",
+        "rev": "da7f4c4842520167f65c20ad75ecdbd14e27ae91",
+        "sha256": "0vdq6lkc1sqj85x8r8idpck3igjns8ix57fqf1r5pm4k0qhy7p2m",
         "type": "tarball",
-        "url": "https://github.com/nixos/nixpkgs/archive/6e7f25001fe6874f7ae271891f709bbf50a22c45.tar.gz",
-        "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
-    },
-    "nixpkgs-unstable": {
-        "branch": "master",
-        "description": "Nix Packages collection",
-        "homepage": "",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "059d331839e2a60dfbc0dce6fbc30fa54772fd2c",
-        "sha256": "06nrv2j65gfkqfqzji5vhwngdi5pmra7sq9493j74msrb19kq595",
-        "type": "tarball",
-        "url": "https://github.com/NixOS/nixpkgs/archive/059d331839e2a60dfbc0dce6fbc30fa54772fd2c.tar.gz",
+        "url": "https://github.com/nixos/nixpkgs/archive/da7f4c4842520167f65c20ad75ecdbd14e27ae91.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     }
 }

rel8.cabal

@@ -6,18 +6,12 @@ license:             BSD3
 license-file:        LICENSE
 author:              Oliver Charles
 maintainer:          ollie@ocharles.org.uk
-build-type:          Custom
-
-custom-setup
- setup-depends:
-   base >= 4 && <5,
-   Cabal,
-   cabal-doctest >= 1 && <1.1
+build-type:          Simple
 
 library
   build-depends:
       aeson
-    , base ^>=4.12 || ^>= 4.13 || ^>= 4.14
+    , base ^>= 4.14 || ^>=4.15
     , bytestring
     , case-insensitive
     , casing
@@ -48,6 +42,9 @@ library
     Rel8.Expr.Time
     Rel8.Tabulate
 
+    -- deprecated
+    Rel8.Aggregate.Legacy
+
   other-modules:
     Rel8.Aggregate
 
@@ -147,6 +144,7 @@ library
     Rel8.Table.Order
     Rel8.Table.Recontextualize
     Rel8.Table.Serialize
+    Rel8.Table.Tag
     Rel8.Table.These
     Rel8.Table.Undefined
 
@@ -198,21 +196,6 @@ test-suite tests
     -Wno-missing-import-lists -Wno-prepositive-qualified-module
     -Wno-deprecations -Wno-monomorphism-restriction
     -Wno-missing-local-signatures -Wno-implicit-prelude
-  buildable: False
-
-test-suite doctests
-  type:             exitcode-stdio-1.0
-  build-depends:
-      base
-    , base-compat
-    , bytestring
-    , doctest
-    , hasql
-    , tmp-postgres
-
-  main-is:          Doctest.hs
-  default-language: Haskell2010
-  buildable: False
 
 test-suite random-queries
   type:             exitcode-stdio-1.0

shell.nix

@@ -6,7 +6,7 @@ let
 in
   hsPkgs.shellFor {
     withHoogle = true;
-    tools = { cabal = "3.2.0.0"; haskell-language-server = "latest"; };
+    tools = { cabal = "latest"; };
     exactDeps = false;
-    buildInputs = [ unstable.postgresql_13 ];
+    buildInputs = [ unstable.postgresql_13 pkgs.pythonPackages.sphinx ];
   }

src/Rel8.hs

@@ -1,19 +1,7 @@
 {-# language DuplicateRecordFields #-}
 
 module Rel8
-  ( -- * Getting Started
-    -- $setup
-
-    -- ** Writing Queries
-    -- $guideQueries
-
-    -- ** Joins
-    -- $guideJoins
-
-    -- ** Aggregation
-    -- $guideAggregation
-
-    -- * Database types
+  ( -- * Database types
     -- ** @DBType@
     DBType(..)
 
@@ -39,7 +27,7 @@ module Rel8
 
     -- * Tables and higher-kinded tables
   , Rel8able
-  , Column
+  , Column, Field, Necessity( Required, Optional )
   , Default, Label
   , HMaybe
   , HList
@@ -200,11 +188,6 @@ module Rel8
   , and
   , or
 
-  , Aggregates
-  , sequenceAggregate
-  , distributeAggregate
-
-
     -- ** Ordering
   , orderBy
   , Order
@@ -264,9 +247,11 @@ import Rel8.Expr.Bool
 import Rel8.Expr.Eq
 import Rel8.Expr.Function
 import Rel8.Expr.Null
+import Rel8.Expr.Opaleye (unsafeCastExpr)
 import Rel8.Expr.Ord
 import Rel8.Expr.Order
 import Rel8.Expr.Serialize
+import Rel8.Kind.Necessity
 import Rel8.Order
 import Rel8.Query
 import Rel8.Query.Aggregate
@@ -286,6 +271,7 @@ import Rel8.Query.These
 import Rel8.Query.Values
 import Rel8.Schema.Column
 import Rel8.Schema.Context.Label
+import Rel8.Schema.Field (Field)
 import Rel8.Schema.Generic
 import Rel8.Schema.HTable
 import Rel8.Schema.Name
@@ -315,8 +301,8 @@ import Rel8.Table.These
 import Rel8.Type
 import Rel8.Type.Eq
 import Rel8.Type.Information
-import Rel8.Type.JSONEncoded
 import Rel8.Type.JSONBEncoded
+import Rel8.Type.JSONEncoded
 import Rel8.Type.Monoid
 import Rel8.Type.Num
 import Rel8.Type.Ord
@@ -324,362 +310,5 @@ import Rel8.Type.ReadShow
 import Rel8.Type.Semigroup
 import Rel8.Type.String
 import Rel8.Type.Sum
-import Rel8.Expr.Opaleye (unsafeCastExpr)
 
 
--- $setup
---
--- In this section, we'll take a look at using Rel8 to work with a small
--- database for Haskell packages. We'll take a look at idiomatic usage of Rel8,
--- mapping tables to Haskell, and then look at writing some simple queries. 
---
--- The documentation in this library uses the following language extensions:
---
--- >>> :set -XBlockArguments 
--- >>> :set -XDeriveAnyClass 
--- >>> :set -XDeriveGeneric 
--- >>> :set -XDerivingStrategies 
--- >>> :set -XDerivingVia 
--- >>> :set -XDuplicateRecordFields
--- >>> :set -XGeneralizedNewtypeDeriving 
--- >>> :set -XOverloadedStrings
--- >>> :set -XStandaloneDeriving 
--- >>> :set -XTypeApplications 
--- >>> :set -XTypeFamilies
---
--- Before we start writing any Haskell, let's take a look at the schema we'll
--- work with.
---
--- > author:                               project:
--- > 
--- >   Column   │  Type   │ Nullable         Column   │  Type   │ Nullable 
--- > ═══════════╪═════════╪══════════      ═══════════╪═════════╪══════════
--- >  author_id │ integer │ not null        author_id │ integer │ not null 
--- >  name      │ text    │ not null        name      │ text    │ not null
--- >  url       │ text    │        
---
--- Our schema consists of two tables - @author@ and @project@. A @project@
--- always has an @author@, but not all @author@s have projects. Each @author@
--- has a name and (maybe) an associated website, and each project has a name.
---
--- Now that we've seen our schema, we can begin writing a mapping in Rel8. The
--- idiomatic way to map a table is to use a record that is parameterised what
--- Rel8 calls an /interpretation functor/, and to define each field with
--- 'Column'.  For this type to be usable with Rel8 we need it to be an instance
--- of 'HigherKindedTable', which can be derived with a combination of
--- @DeriveAnyClass@ and @DeriveGeneric@.
---
--- Following these steps for @author@, we have:
---
--- > data Author f = Author
--- >   { authorId :: Column f Int64
--- >   , name     :: Column f Text
--- >   , url      :: Column f (Maybe Text)
--- >   } deriving (Generic, HigherKindedTable)
---
--- This is a perfectly reasonable definition, but cautious readers might notice
--- a problem - in particular, with the type of the @authorId@ field.  While
--- @Int64@ is correct, it's not the best type. If we had other identifier types
--- in our project, it would be too easy to accidentally mix them up and create
--- nonsensical joins. As Haskell programmers, we often solve this problem by
--- creating @newtype@ wrappers, and we can also use this technique with Rel8:
---
--- >>> :{
--- newtype AuthorId = AuthorId { toInt64 :: Int64 } 
---   deriving newtype (DBEq, DBType, Eq, Show)
--- :}
---
--- Now we can write our final schema mapping. First, the @author@ table:
---
--- >>> :{
--- data Author f = Author
---   { authorId   :: Column f AuthorId
---   , authorName :: Column f Text
---   , authorUrl  :: Column f (Maybe Text)
---   } 
---   deriving stock Generic
---   deriving anyclass HigherKindedTable
--- :}
---
--- And similarly, the @project@ table:
---
--- >>> :{
--- data Project f = Project
---   { projectAuthorId :: Column f AuthorId
---   , projectName     :: Column f Text
---   } 
---   deriving stock Generic
---   deriving anyclass HigherKindedTable
--- :}
---
--- To show query results in this documentation, we'll also need @Show@
--- instances: Unfortunately these definitions look a bit scary, but they are
--- essentially just @deriving (Show)@:
---
--- >>> deriving stock instance f ~ Identity => Show (Author f)
--- >>> deriving stock instance f ~ Identity => Show (Project f)
---
--- These data types describe the structural mapping of the tables, but we also
--- need to specify a 'TableSchema' for each table. A @TableSchema@ contains the
--- name of the table and the name of all columns in the table, which will
--- ultimately allow us to @SELECT@ and @INSERT@ rows for these tables.
---
--- To define a @TableSchema@, we just need to fill construct appropriate
--- @TableSchema@ values. When it comes to the @tableColumns@ field, we
--- construct values of our data types above, and set each field to the name of
--- the column that it maps to:
---
--- First, @authorSchema@ describes the column names of the @author@ table when
--- associated with the @Author@ type:
---
--- >>> :{
--- authorSchema :: TableSchema (Author ColumnSchema)
--- authorSchema = TableSchema
---   { tableName = "author"
---   , tableSchema = Nothing
---   , tableColumns = Author
---       { authorId = "author_id"
---       , authorName = "name"
---       , authorUrl = "url"
---       }
---   }
--- :}
---
--- And likewise for @project@ and @Project@:
---
--- >>> :{
--- projectSchema :: TableSchema (Project ColumnSchema)
--- projectSchema = TableSchema
---   { tableName = "project"
---   , tableSchema = Nothing
---   , tableColumns = Project
---       { projectAuthorId = "author_id"
---       , projectName = "name"
---       }
---   }
--- :}
---
--- Aside: you might be wondering why this information isn't in the definitions
--- of @Author@ and @Project@ above. Rel8 decouples @TableSchema@ from the data
--- types themselves, as not all tables you define will necessarily have a
--- schema. For example, Rel8 allows you to define helper types to simplify the
--- types of queries - these tables only exist at query time, but there is no
--- corresponding base table. We'll see more on this idea later!
---
--- With these table definitions, we can now start writing some queries! To
--- actually run a query, we'll need a database connection. Rel8 uses the
--- @hasql@ library, and for this documentation we'll get the connection string
--- from the @$TEST_DATABASE_URL@ environment variable.
---
--- >>> connectionString <- System.Environment.getEnv "TEST_DATABASE_URL"
--- >>> Right c <- Hasql.Connection.acquire (Data.ByteString.Char8.pack connectionString)
--- >>> Control.Monad.void $ Hasql.Session.run (Hasql.Session.sql "BEGIN") c
-
--- $guideQueries
--- 
--- First, we'll take a look at @SELECT@ statements - usually the bulk of most
--- database heavy applications.
--- 
--- In Rel8, @SELECT@ statements are built using the 'Query' monad. You can
--- think of this monad like the ordinary @[]@ (List) monad - but this isn't
--- required knowledge. 
--- 
--- To start, we'll look at one of the simplest queries possible - a basic
--- @SELECT * FROM@ statement. To select all rows from a table, we use 'each',
--- and supply a 'TableSchema'. So to select all @project@ rows, we can write:
--- 
--- >>> :t each projectSchema
--- each projectSchema :: Query (Project Expr)
--- 
--- Notice that @each@ gives us a @Query@ that yields @Project Expr@ rows. To
--- see what this means, let's have a look at a single field of a 
--- @Project Expr@:
--- 
--- >>> let aProjectExpr = undefined :: Project Expr
--- >>> :t projectAuthorId aProjectExpr
--- projectAuthorId aProjectExpr :: Expr AuthorId
--- 
--- Recall we defined @projectAuthorId@ as @Column f AuthorId@. Now we have @f@
--- is @Expr@, and @Column Expr AuthorId@ reduces to @Expr AuthorId@. We'll see
--- more about @Expr@ soon, but you can think of @Expr a@ as "SQL expressions of
--- type @a@".
--- 
--- To execute this @Query@, we pass it to 'select':
--- 
--- >>> :t select c (each projectSchema)
--- select c (each projectSchema) :: MonadIO m => m [Project Identity]
--- 
--- When we @select@ things containing @Expr@s, Rel8 builds a new response table
--- with the @Identity@ interpretation. This means you'll get back plain Haskell
--- values. Studying @projectAuthorId@ again, we have:
--- 
--- >>> let aProjectIdentity = undefined :: Project Identity
--- >>> :t projectAuthorId aProjectIdentity
--- projectAuthorId aProjectIdentity :: AuthorId
--- 
--- Here @Column Identity AuthorId@ reduces to just @AuthorId@, with no
--- wrappping type at all.
--- 
--- Putting this all together, we can run our first query:
--- 
--- >>> select c (each projectSchema) >>= mapM_ print
--- Project {projectAuthorId = 1, projectName = "rel8"}
--- Project {projectAuthorId = 2, projectName = "aeson"}
--- Project {projectAuthorId = 2, projectName = "text"}
--- 
--- Cool!
---
--- We now know that 'each' is the equivalent of a @SELECT *@ query, but
--- sometimes we're only interested in a subset of the columns of a table. To
--- restrict the returned columns, we can specify a projection by using 'Query's
--- @Functor@ instance:
---
--- >>> select c $ projectName <$> each projectSchema
--- ["rel8","aeson","text"]
-
--- $guideJoins
--- 
--- Another common operation in relational databases is to take the @JOIN@ of
--- multiple tables. Rel8 doesn't have a specific join operation, but we can
--- recover the functionality of a join by selecting all rows of two tables, and
--- then using 'where_' to filter them.
---
--- To see how this works, first let's look at taking the product of two tables.
--- We can do this by simply calling 'each' twice, and then returning a tuple of
--- their results.
---
--- >>> :{
--- mapM_ print =<< select c do
---   author  <- each authorSchema
---   project <- each projectSchema
---   return (projectName project, authorName author)
--- :}
--- ("rel8","Ollie")
--- ("rel8","Bryan O'Sullivan")
--- ("rel8","Emily Pillmore")
--- ("aeson","Ollie")
--- ("aeson","Bryan O'Sullivan")
--- ("aeson","Emily Pillmore")
--- ("text","Ollie")
--- ("text","Bryan O'Sullivan")
--- ("text","Emily Pillmore")
---
--- This isn't quite right, though, as we have ended up pairing up the wrong
--- projects and authors. To fix this, we can use 'where_' to restrict the
--- returned rows. We could write:
--- 
--- > select c $ do
--- >   author  <- each authorSchema
--- >   project <- each projectSchema
--- >   where_ $ projectAuthorId project ==. authorId author
--- >   return (project, author)
---
--- but doing this every time you need a join can obscure the meaning of the
--- query you're writing. A good practice is to introduce specialised functions
--- for the particular joins in your database. In our case, this would be:
---
--- >>> :{
--- projectsForAuthor :: Author Expr -> Query (Project Expr)
--- projectsForAuthor a = each projectSchema >>= filter \p ->
---   projectAuthorId p ==. authorId a
--- :}
---
--- Our final query is then:
---
--- >>> :{
--- mapM_ print =<< select c do
---   author  <- each authorSchema
---   project <- projectsForAuthor author
---   return (projectName project, authorName author)
--- :}
--- ("rel8","Ollie")
--- ("aeson","Bryan O'Sullivan")
--- ("text","Bryan O'Sullivan")
---
--- == @LEFT JOIN@s
---
--- Rel8 is also capable of performing @LEFT JOIN@s. To perform @LEFT JOIN@s, we
--- follow the same approach as before, but use the 'optional' query transformer
--- to allow for the possibility of the join to fail.
---
--- In our test database, we can see that there's another author who we haven't
--- seen yet:
---
--- >>> select c $ authorName <$> each authorSchema
--- ["Ollie","Bryan O'Sullivan","Emily Pillmore"]
---
--- Emily wasn't returned in our earlier query because - in our database - she
--- doesn't have any registered projects. We can account for this partiality in
--- our original query by wrapping the @projectsForAuthor@ call with 'optional':
---
--- >>> :{
--- mapM_ print =<< select c do
---   author   <- each authorSchema
---   mproject <- optional $ projectsForAuthor author
---   return (authorName author, projectName <$> mproject)
--- :}
--- ("Ollie",Just "rel8")
--- ("Bryan O'Sullivan",Just "aeson")
--- ("Bryan O'Sullivan",Just "text")
--- ("Emily Pillmore",Nothing)
-
--- $guideAggregation
---
--- Aggregations are operations like @sum@ and @count@ - operations that reduce
--- multiple rows to single values. To perform aggregations in Rel8, we can use
--- the 'aggregate' function, which takes a 'Query' of aggregated expressions,
--- runs the aggregation, and returns aggregated rows.
---
--- To start, let's look at a simple aggregation that tells us how many projects
--- exist:
---
--- >>> error "TODO"
---
--- Rel8 is also capable of aggregating multiple rows into a single row by
--- concatenating all rows as a list. This aggregation allows us to break free
--- of the row-orientated nature of SQL and write queries that return tree-like
--- structures. Earlier we saw an example of returning authors with their
--- projects, but the query didn't do a great job of describing the one-to-many
--- relationship between authors and their projects.
---
--- Let's look again at a query that returns authors and their projects, and
--- focus on the /type/ of that query. 
---
--- >>> :{
--- projectsForAuthor a = each projectSchema >>= filter \p ->
---   projectAuthorId p ==. authorId a
--- :}
---
--- >>> :{
--- let authorsAndProjects = do
---       author  <- each authorSchema
---       project <- projectsForAuthor author
---       return (author, project)
---       where
--- :}
---
--- >>> :t select c authorsAndProjects
--- select c authorsAndProjects 
---   :: MonadIO m => m [(Author Identity, Project Identity)]
---
--- Our query gives us a single list of pairs of authors and projects. However,
--- with our domain knowledge of the schema, this isn't a great type - what we'd
--- rather have is a list of pairs of authors and /lists/ of projects. That is,
--- what we'd like is:
---
--- > [(Author Identity, [Project Identity])]
---
--- This would be a much better type! Rel8 can produce a query with this type by
--- simply wrapping the call to @projectsForAuthor@ with either 'some' or
--- 'many'. Here we'll use 'many', which allows for the possibility of an author
--- to have no projects:
---
--- >>> :{
--- mapM_ print =<< select c do
---   author       <- each authorSchema
---   projectNames <- many $ projectName <$> projectsForAuthor author
---   return (authorName author, projectNames)
--- :}
--- ("Ollie",["rel8"])
--- ("Bryan O'Sullivan",["aeson","text"])
--- ("Emily Pillmore",[])

src/Rel8/Aggregate.hs

@@ -12,7 +12,7 @@
 {-# language UndecidableSuperClasses #-}
 
 module Rel8.Aggregate
-  ( Aggregate(..)
+  ( Aggregate(..), foldInputs, mapInputs
   , Aggregator(..), unsafeMakeAggregate
   , Aggregates
   , Col( Aggregation )
@@ -20,12 +20,9 @@ module Rel8.Aggregate
 where
 
 -- base
-import Control.Applicative ( empty )
-import Data.Foldable ( fold )
 import Data.Functor.Const ( Const( Const ), getConst )
 import Data.Functor.Identity ( Identity )
 import Data.Kind ( Constraint, Type )
-import Data.Monoid ( First( First ), getFirst )
 import Prelude
 
 -- opaleye
@@ -35,14 +32,9 @@ import qualified Opaleye.Internal.PackMap as Opaleye
 
 -- rel8
 import Rel8.Expr ( Expr, Col(..) )
-import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
 import Rel8.Opaque ( Opaque )
 import Rel8.Schema.Context ( Interpretation(..) )
 import Rel8.Schema.Context.Label ( Labelable(..) )
-import Rel8.Schema.Context.Nullify
-  ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
-  , runTag, unnull
-  )
 import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Nullability ( Sql )
@@ -56,7 +48,7 @@ import Data.Functor.Apply ( Apply, WrappedApplicative(..) )
 
 
 -- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can
--- unpack an @Aggregate@ back to @a@ by running it with 'aggregate'. As
+-- unpack an @Aggregate@ back to @a@ by running it with 'Rel8.aggregate'. As
 -- @Aggregate@ is almost an 'Applicative' functor - but there is no 'pure'
 -- operation. This means 'Aggregate' is an instance of 'Apply', and you can
 -- combine @Aggregate@s using the @<.>@ combinator.
@@ -117,30 +109,6 @@ instance Labelable Aggregate where
   unlabeler (Aggregation aggregate) = Aggregation aggregate
 
 
-instance Nullifiable Aggregate where
-  encodeTag = Aggregation . groupByExpr
-    where
-      groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing
-  decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate
-    where
-      undoGroupBy = getFirst . foldInputs go
-        where
-          go Nothing = pure . fromPrimExpr
-          go _ = const $ First empty
-
-  nullifier tag SSpec {nullability} (Aggregation aggregate) = Aggregation $
-    mapInputs (toPrimExpr . runTag nullability tag . fromPrimExpr) $
-    runTag nullability tag <$> aggregate
-
-  unnullifier _ SSpec {nullability} (Aggregation aggregate) =
-    Aggregation $ unnull nullability <$> aggregate
-
-  {-# INLINABLE encodeTag #-}
-  {-# INLINABLE decodeTag #-}
-  {-# INLINABLE nullifier #-}
-  {-# INLINABLE unnullifier #-}
-
-
 -- | @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/Aggregate/Legacy.hs

@@ -0,0 +1,93 @@
+{-# language FlexibleContexts #-}
+{-# language NamedFieldPuns #-}
+{-# language ScopedTypeVariables #-}
+{-# language TypeApplications #-}
+{-# language TypeFamilies #-}
+{-# language ViewPatterns #-}
+
+module Rel8.Aggregate.Legacy
+  ( Aggregates
+  , aggregate
+  , aggregateTabulation
+  , groupBy
+  , listAgg
+  , nonEmptyAgg
+  )
+where
+
+-- base
+import Data.Functor.Identity ( Identity( Identity ) )
+import Prelude
+
+-- opaleye
+import qualified Opaleye.Aggregate as Opaleye
+
+-- rel8
+import Rel8.Aggregate ( Aggregates, Col(..) )
+import Rel8.Expr ( Col(..) )
+import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
+import Rel8.Query ( Query )
+import Rel8.Query.Opaleye ( mapOpaleye )
+import Rel8.Schema.Dict ( Dict( Dict ) )
+import Rel8.Schema.HTable ( htabulate, hfield )
+import Rel8.Schema.HTable.Vectorize ( hvectorize )
+import Rel8.Table ( toColumns, fromColumns )
+import Rel8.Table.Eq ( EqTable, eqTable )
+import Rel8.Table.List ( ListTable )
+import Rel8.Table.NonEmpty ( NonEmptyTable )
+import Rel8.Table.Opaleye ( aggregator )
+import Rel8.Tabulate ( Tabulation )
+import qualified Rel8.Tabulate
+
+
+-- | Apply an aggregation to all rows returned by a 'Query'.
+aggregate :: Aggregates aggregates exprs => Query aggregates -> Query exprs
+aggregate = mapOpaleye (Opaleye.aggregate aggregator) . fmap (fromColumns . toColumns)
+
+
+aggregateTabulation
+  :: (EqTable k, Aggregates aggregates exprs)
+  => (t -> aggregates) -> Tabulation k t -> Tabulation k exprs
+aggregateTabulation f =
+  Rel8.Tabulate.aggregateTabulation . fmap (fromColumns . toColumns . f)
+
+
+-- | Group equal tables together. This works by aggregating each column in the
+-- given table with 'groupByExpr'.
+groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)
+  => exprs -> aggregates
+groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
+  case hfield (eqTable @exprs) field of
+    Dict -> case hfield exprs field of
+      DB expr -> Aggregation $ groupByExpr expr
+
+
+-- | Aggregate rows into a single row containing an array of all aggregated
+-- rows. This can be used to associate multiple rows with a single row, without
+-- changing the over cardinality of the query. This allows you to essentially
+-- return a tree-like structure from queries.
+--
+-- For example, if we have a table of orders and each orders contains multiple
+-- items, we could aggregate the table of orders, pairing each order with its
+-- items:
+--
+-- @
+-- ordersWithItems :: Query (Order Expr, ListTable (Item Expr))
+-- ordersWithItems = do
+--   order <- each orderSchema
+--   items <- aggregate $ listAgg <$> itemsFromOrder order
+--   return (order, items)
+-- @
+listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates
+listAgg (toColumns -> exprs) = fromColumns $
+  hvectorize
+    (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
+    (pure exprs)
+
+
+-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.
+nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
+nonEmptyAgg (toColumns -> exprs) = fromColumns $
+  hvectorize
+    (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
+    (pure exprs)

src/Rel8/Expr.hs

@@ -38,16 +38,12 @@ 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.Context.Nullify
-  ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
-  , runTag, unnull
-  )
 import Rel8.Schema.HTable.Type ( HType( HType ) )
 import Rel8.Schema.Nullability
   ( Nullability( Nullable, NonNullable )
   , Sql, nullabilization
   )
-import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
+import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Type ( DBType )
@@ -128,15 +124,3 @@ instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)
 instance Labelable Expr where
   labeler (DB a) = DB a
   unlabeler (DB a) = DB a
-
-
-instance Nullifiable Expr where
-  encodeTag = DB
-  decodeTag (DB a) = a
-  nullifier tag SSpec {nullability} (DB a) = DB $ runTag nullability tag a
-  unnullifier _ SSpec {nullability} (DB a) = DB $ unnull nullability a
-
-  {-# INLINABLE encodeTag #-}
-  {-# INLINABLE decodeTag #-}
-  {-# INLINABLE nullifier #-}
-  {-# INLINABLE unnullifier #-}

src/Rel8/Expr/Aggregate.hs

@@ -130,6 +130,7 @@ sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $
     }
 
 
+-- | Take the sum of all expressions that satisfy a predicate.
 sumWhere :: (Sql DBNum a, Sql DBSum a)
   => Expr Bool -> Expr a -> Aggregate (Expr a)
 sumWhere condition a = sum (caseExpr [(condition, a)] 0)

src/Rel8/Expr/Bool.hs

@@ -32,68 +32,28 @@ true = litExpr True
 
 
 -- | The SQL @AND@ operator.
---
--- >>> :{
--- mapM_ print =<< select c do
---   x <- values [lit True, lit False]
---   y <- values [lit True, lit False]
---   return (x, y, x &&. y)
--- :}
--- (True,True,True)
--- (True,False,False)
--- (False,True,False)
--- (False,False,False)
 (&&.) :: Expr Bool -> Expr Bool -> Expr Bool
 (&&.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpAnd)
 infixr 3 &&.
 
 
 -- | The SQL @OR@ operator.
---
--- >>> :{
--- mapM_ print =<< select c do
---   x <- values [lit True, lit False]
---   y <- values [lit True, lit False]
---   return (x, y, x ||. y)
--- :}
--- (True,True,True)
--- (True,False,True)
--- (False,True,True)
--- (False,False,False)
 (||.) :: Expr Bool -> Expr Bool -> Expr Bool
 (||.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpOr)
 infixr 2 ||.
 
 
 -- | The SQL @NOT@ operator.
---
--- >>> select c $ pure $ not_ $ lit True
--- [False]
---
--- >>> select c $ pure $ not_ $ lit False
--- [True]
 not_ :: Expr Bool -> Expr Bool
 not_ = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNot)
 
 
 -- | Fold @AND@ over a collection of expressions.
---  
--- >>> select c $ pure $ and_ [ lit True ==. lit False, lit False, lit True ]
--- [False]
---  
--- >>> select c $ pure $ and_ []
--- [True]
 and_ :: Foldable f => f (Expr Bool) -> Expr Bool
 and_ = foldl' (&&.) true
 
 
 -- | Fold @OR@ over a collection of expressions.
--- 
--- >>> select c $ pure $ or_ [ lit True ==. lit False, lit False, lit True ]
--- [True]
---  
--- >>> select c $ pure $ or_ []
--- [False]
 or_ :: Foldable f => f (Expr Bool) -> Expr Bool
 or_ = foldl' (||.) false
 
@@ -118,6 +78,10 @@ caseExpr branches (Expr fallback) =
     go (Expr condition, Expr value) = (condition, value)
 
 
+-- | Convert a @Expr (Maybe Bool)@ to a @Expr Bool@ by treating @Nothing@ as
+-- @False@. This can be useful when combined with 'Rel8.where_', which expects
+-- a @Bool@, and produces expressions that optimize better than general case
+-- analysis.
 coalesce :: Expr (Maybe Bool) -> Expr Bool
 coalesce (Expr a) = Expr a &&. Expr (Opaleye.FunExpr "COALESCE" [a, untrue])
   where

src/Rel8/Expr/Eq.hs

@@ -74,12 +74,6 @@ infix 4 /=.
 --
 -- This corresponds to the SQL @=@ operator, though it will always return a
 -- 'Bool'.
---
--- >>> select c $ pure $ lit Nothing ==? lit True
--- False
---
--- >>> select c $ pure $ lit Nothing ==? lit Nothing
--- False
 (==?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
 a ==? b = coalesce $ unsafeLiftOpNullable eq a b
 infix 4 ==?
@@ -89,12 +83,6 @@ infix 4 ==?
 --
 -- This corresponds to the SQL @<>@ operator, though it will always return a
 -- 'Bool'.
---
--- >>> select c $ pure $ lit Nothing /=? lit True
--- True
---
--- >>> select c $ pure $ lit Nothing /=? lit Nothing
--- False
 (/=?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
 a /=? b = coalesce $ unsafeLiftOpNullable ne a b
 infix 4 /=?
@@ -102,12 +90,6 @@ infix 4 /=?
 
 -- | Like the SQL @IN@ operator, but implemented by folding over a list with
 -- '==.' and '||.'.
---
--- >>> select c $ return $ lit (5 :: Int32) `in_` [ lit x | x <- [1..5] ]
--- [True]
---
--- >>> select c $ return $ lit (42 :: Int32) `in_` [ lit x | x <- [1..5] ]
--- [False]
 in_ :: forall a f. (Sql DBEq a, Foldable f)
   => Expr a -> f (Expr a) -> Expr Bool
 in_ a (toList -> as) = case nullabilization @a of

src/Rel8/Expr/Function.hs

@@ -47,42 +47,11 @@ instance (arg ~ Expr a, Function args res) => Function arg (args -> res) where
 
 -- | Construct an n-ary function that produces an 'Expr' that when called runs
 -- a SQL function.
--- 
--- For example, here's how we can wrap PostgreSQL's @factorial@ function:
--- 
--- >>> :{
--- factorial :: Expr Int64 -> Expr Data.Scientific.Scientific
--- factorial = function "factorial"
--- :}
--- 
--- >>> select c $ pure $ factorial 5
--- [120.0]
--- 
--- The same approach works for any number of arguments:
--- 
--- >>> :{
--- power :: Expr Float -> Expr Float -> Expr Double
--- power = function "power"
--- :}
--- 
--- >>> select c $ pure $ power 9 3
--- [729.0]
 function :: Function args result => String -> args -> result
 function = applyArgument . Opaleye.FunExpr
 
 
 -- | Construct a function call for functions with no arguments.
--- 
--- For example, we can call the database function @pi()@ by using
--- @nullaryFunction@:
--- 
--- >>> :{
--- sqlPi :: Expr Double
--- sqlPi = nullaryFunction "pi"
--- :}
--- 
--- >>> select c $ pure $ sqlPi
--- [3.141592653589793]
 nullaryFunction :: Sql DBType a => String -> Expr a
 nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])
 

src/Rel8/Expr/Null.hs

@@ -40,12 +40,6 @@ unsafeUnnullify (Expr a) = Expr a
 
 
 -- | Like 'maybe', but to eliminate @null@.
---
--- >>> select c $ pure $ null 0 id (nullExpr :: Expr (Maybe Int32))
--- [0]
---
--- >>> select c $ pure $ null 0 id (lit (Just 42) :: Expr (Maybe Int32))
--- [42]
 nullable :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b
 nullable b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)
 
@@ -54,18 +48,12 @@ nullableOf :: DBType a => Maybe (Expr a) -> Expr (Maybe a)
 nullableOf = maybe null nullify
 
 
--- | Like 'isNothing', but for @null@.
---
--- >>> select c $ pure $ isNull (nullExpr :: Expr (Maybe Int32))
--- [True]
---
--- >>> select c $ pure $ isNull (lit (Just 42) :: Expr (Maybe Int32))
--- [False]
+-- | Like 'Data.Maybe.isNothing', but for @null@.
 isNull :: Expr (Maybe a) -> Expr Bool
 isNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNull)
 
 
--- | Like 'isJust', but for @null@.
+-- | Like 'Data.Maybe.isJust', but for @null@.
 isNonNull :: Expr (Maybe a) -> Expr Bool
 isNonNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNotNull)
 

src/Rel8/Expr/Num.hs

@@ -19,39 +19,59 @@ import Rel8.Schema.Nullability ( Homonullable, Sql )
 import Rel8.Type.Num ( DBFractional, DBIntegral, DBNum )
 
 
+-- | Cast 'DBIntegral' types to 'DBNum' types. For example, this can be useful
+-- if you need to turn an @Expr Int32@ into an @Expr Double@.
 fromIntegral :: (Sql DBIntegral a, Sql DBNum b, Homonullable a b)
   => Expr a -> Expr b
 fromIntegral (Expr a) = castExpr (Expr a)
 
 
+-- | Cast 'DBNum' types to 'DBFractional' types. For example, his can be useful
+-- to convert @Expr Float@ to @Expr Double@.
 realToFrac :: (Sql DBNum a, Sql DBFractional b, Homonullable a b)
   => Expr a -> Expr b
 realToFrac (Expr a) = castExpr (Expr a)
 
 
+-- | Round a 'DBFractional' to a 'DBIntegral' by rounding to the nearest larger
+-- integer.
+--
+-- Corresponds to the @ceiling()@ function.
 ceiling :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
   => Expr a -> Expr b
 ceiling = function "CEILING"
 
 
+-- | Perform integral division. Corresponds to the @div()@ function.
 div :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
 div = function "DIV"
 
 
+-- | Corresponds to the @mod()@ function.
 mod :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
 mod = function "MOD"
 
 
+-- | Round a 'DFractional' to a 'DBIntegral' by rounding to the nearest smaller
+-- integer. 
+--
+-- Corresponds to the @floor()@ function.
 floor :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
   => Expr a -> Expr b
 floor = function "FLOOR"
 
 
+-- | Round a 'DBFractional' to a 'DBIntegral' by rounding to the nearest
+-- integer.
+--
+-- Corresponds to the @round()@ function.
 round :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
   => Expr a -> Expr b
 round = function "ROUND"
 
 
+-- | Round a 'DBFractional' to a 'DBIntegral' by rounding to the nearest
+-- integer towards zero.
 truncate :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
   => Expr a -> Expr b
 truncate = function "TRUNC"

src/Rel8/Expr/Opaleye.hs

@@ -34,6 +34,8 @@ castExpr :: Sql DBType a => Expr a -> Expr a
 castExpr = scastExpr typeInformation
 
 
+-- | Cast an expression to a different type. Corresponds to a @CAST()@ function
+-- call.
 unsafeCastExpr :: Sql DBType b => Expr a -> Expr b
 unsafeCastExpr = sunsafeCastExpr typeInformation
 

src/Rel8/Expr/Order.hs

@@ -28,9 +28,6 @@ import Rel8.Type.Ord ( DBOrd )
 
 
 -- | Sort a column in ascending order.
---
--- >>> select c $ orderBy asc $ values [ lit x | x <- [1..5 :: Int32] ]
--- [1,2,3,4,5]
 asc :: DBOrd a => Order (Expr a)
 asc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])
   where
@@ -42,9 +39,6 @@ asc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])
 
 
 -- | Sort a column in descending order.
---
--- >>> select c $ orderBy desc $ values [ lit x | x <- [1..5 :: Int32] ]
--- [5,4,3,2,1]
 desc :: DBOrd a => Order (Expr a)
 desc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])
   where
@@ -57,9 +51,6 @@ desc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])
 
 -- | Transform an ordering so that @null@ values appear first. This corresponds
 -- to @NULLS FIRST@ in SQL.
---
--- >>> select c $ orderBy (nullsFirst desc) $ values $ [ nullExpr, nullExpr ] <> [ lit (Just x) | x <- [1..5 :: Int32] ]
--- [Nothing,Nothing,Just 5,Just 4,Just 3,Just 2,Just 1]
 nullsFirst :: Order (Expr a) -> Order (Expr (Maybe a))
 nullsFirst (Order (Opaleye.Order f)) =
   Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify
@@ -70,9 +61,6 @@ nullsFirst (Order (Opaleye.Order f)) =
 
 -- | Transform an ordering so that @null@ values appear first. This corresponds
 -- to @NULLS LAST@ in SQL.
---
--- >>> select c $ orderBy (nullsLast desc) $ values $ [ nullExpr, nullExpr ] <> [ lit (Just x) | x <- [1..5 :: Int32] ]
--- [Just 5,Just 4,Just 3,Just 2,Just 1,Nothing,Nothing]
 nullsLast :: Order (Expr a) -> Order (Expr (Maybe a))
 nullsLast (Order (Opaleye.Order f)) =
   Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify

src/Rel8/Expr/Serialize.hs

@@ -30,6 +30,10 @@ import Rel8.Type ( DBType, typeInformation )
 import Rel8.Type.Information ( TypeInformation(..) )
 
 
+-- | Produce an expression from a literal.
+--
+-- Note that you can usually use 'Rel8.lit', but @litExpr@ can solve problems
+-- of inference in polymorphic code.
 litExpr :: Sql DBType a => a -> Expr a
 litExpr = slitExpr nullabilization typeInformation
 
@@ -44,6 +48,6 @@ slitExpr nullability info@TypeInformation {encode} =
 
 
 sparseValue :: Nullability a -> TypeInformation (Unnullify a) -> Hasql.Row a
-sparseValue nullability TypeInformation {decode, out} = case nullability of
-  Nullable -> Hasql.column $ Hasql.nullable $ out <$> decode
-  NonNullable -> Hasql.column $ Hasql.nonNullable $ out <$> decode
+sparseValue nullability TypeInformation {decode} = case nullability of
+  Nullable -> Hasql.column $ Hasql.nullable decode
+  NonNullable -> Hasql.column $ Hasql.nonNullable decode

src/Rel8/Expr/Text.hs

@@ -16,7 +16,7 @@ module Rel8.Expr.Text
   , initcap, left, length, lengthEncoding, lpad, ltrim, md5
   , pgClientEncoding, quoteIdent, quoteLiteral, quoteNullable, regexpReplace
   , regexpSplitToArray, repeat, replace, reverse, right, rpad, rtrim
-  , splitPart, strpos, substr, toAscii, toHex, translate
+  , splitPart, strpos, substr, translate
   )
 where
 
@@ -50,24 +50,32 @@ infixr 6 ++.
 
 
 -- | Matches regular expression, case sensitive
+-- 
+-- Corresponds to the @~.@ operator.
 (~.) :: Expr Text -> Expr Text -> Expr Bool
 (~.) = binaryOperator "~."
 infix 2 ~.
 
 
 -- | Matches regular expression, case insensitive
+--
+-- Corresponds to the @~*@ operator.
 (~*) :: Expr Text -> Expr Text -> Expr Bool
 (~*) = binaryOperator "~*"
 infix 2 ~*
 
 
 -- | Does not match regular expression, case sensitive
+--
+-- Corresponds to the @!~@ operator.
 (!~) :: Expr Text -> Expr Text -> Expr Bool
 (!~) = binaryOperator "!~"
 infix 2 !~
 
 
 -- | Does not match regular expression, case insensitive
+--
+-- Corresponds to the @!~*@ operator.
 (!~*) :: Expr Text -> Expr Text -> Expr Bool
 (!~*) = binaryOperator "!~*"
 infix 2 !~*
@@ -78,164 +86,191 @@ infix 2 !~*
 -- * Standard SQL functions
 
 
+-- | Corresponds to the @bit_length@ function.
 bitLength :: Expr Text -> Expr Int32
 bitLength = function "bit_length"
 
 
+-- | Corresponds to the @char_length@ function.
 charLength :: Expr Text -> Expr Int32
 charLength = function "char_length"
 
 
+-- | Corresponds to the @lower@ function.
 lower :: Expr Text -> Expr Text
 lower = function "lower"
 
 
+-- | Corresponds to the @octet_length@ function.
 octetLength :: Expr Text -> Expr Int32
 octetLength = function "octet_length"
 
 
+-- | Corresponds to the @upper@ function.
 upper :: Expr Text -> Expr Text
 upper = function "upper"
 
 
--- * PostgreSQL functions
+-- | Corresponds to the @ascii@ function.
 ascii :: Expr Text -> Expr Int32
 ascii = function "ascii"
 
 
+-- | Corresponds to the @btrim@ function.
 btrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
 btrim a (Just b) = function "btrim" a b
 btrim a Nothing = function "btrim" a
 
 
+-- | Corresponds to the @chr@ function.
 chr :: Expr Int32 -> Expr Text
 chr = function "chr"
 
 
+-- | Corresponds to the @convert@ function.
 convert :: Expr ByteString -> Expr Text -> Expr Text -> Expr ByteString
 convert = function "convert"
 
 
+-- | Corresponds to the @convert_from@ function.
 convertFrom :: Expr ByteString -> Expr Text -> Expr Text
 convertFrom = function "convert_from"
 
 
+-- | Corresponds to the @convert_to@ function.
 convertTo :: Expr Text -> Expr Text -> Expr ByteString
 convertTo = function "convert_to"
 
 
+-- | Corresponds to the @decode@ function.
 decode :: Expr Text -> Expr Text -> Expr ByteString
 decode = function "decode"
 
 
+-- | Corresponds to the @encode@ function.
 encode :: Expr ByteString -> Expr Text -> Expr Text
 encode = function "encode"
 
 
+-- | Corresponds to the @initcap@ function.
 initcap :: Expr Text -> Expr Text
 initcap = function "initcap"
 
 
+-- | Corresponds to the @left@ function.
 left :: Expr Text -> Expr Int32 -> Expr Text
 left = function "left"
 
 
+-- | Corresponds to the @length@ function.
 length :: Expr Text -> Expr Int32
 length = function "length"
 
 
+-- | Corresponds to the @length@ function.
 lengthEncoding :: Expr ByteString -> Expr Text -> Expr Int32
 lengthEncoding = function "length"
 
 
+-- | Corresponds to the @lpad@ function.
 lpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
 lpad a b (Just c) = function "lpad" a b c
 lpad a b Nothing = function "lpad" a b
 
 
+-- | Corresponds to the @ltrim@ function.
 ltrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
 ltrim a (Just b) = function "ltrim" a b
 ltrim a Nothing = function "ltrim" a
 
 
+-- | Corresponds to the @md5@ function.
 md5 :: Expr Text -> Expr Text
 md5 = function "md5"
 
 
+-- | Corresponds to the @pg_client_encoding()@ expression.
 pgClientEncoding :: Expr Text
 pgClientEncoding = nullaryFunction "pg_client_encoding"
 
 
+-- | Corresponds to the @quote_ident@ function.
 quoteIdent :: Expr Text -> Expr Text
 quoteIdent = function "quote_ident"
 
 
+-- | Corresponds to the @quote_literal@ function.
 quoteLiteral :: Expr Text -> Expr Text
 quoteLiteral = function "quote_literal"
 
 
+-- | Corresponds to the @quote_nullable@ function.
 quoteNullable :: Expr Text -> Expr Text
 quoteNullable = function "quote_nullable"
 
 
+-- | Corresponds to the @regexp_replace@ function.
 regexpReplace :: ()
   => Expr Text -> Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr Text
 regexpReplace a b c (Just d) = function "regexp_replace" a b c d
 regexpReplace a b c Nothing = function "regexp_replace" a b c
 
 
+-- | Corresponds to the @regexp_split_to_array@ function.
 regexpSplitToArray :: ()
   => Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr (Array1D Text)
 regexpSplitToArray a b (Just c) = function "regexp_split_to_array" a b c
 regexpSplitToArray a b Nothing = function "regexp_split_to_array" a b
 
 
+-- | Corresponds to the @repeat@ function.
 repeat :: Expr Text -> Expr Int32 -> Expr Text
 repeat = function "repeat"
 
 
+-- | Corresponds to the @replace@ function.
 replace :: Expr Text -> Expr Text -> Expr Text -> Expr Text
 replace = function "replace"
 
 
+-- | Corresponds to the @reverse@ function.
 reverse :: Expr Text -> Expr Text
 reverse = function "reverse"
 
 
+-- | Corresponds to the @right@ function.
 right :: Expr Text -> Expr Int32 -> Expr Text
 right = function "right"
 
 
+-- | Corresponds to the @rpad@ function.
 rpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text
 rpad a b (Just c) = function "rpad" a b c
 rpad a b Nothing = function "rpad" a b
 
 
+-- | Corresponds to the @rtrim@ function.
 rtrim :: Expr Text -> Maybe (Expr Text) -> Expr Text
 rtrim a (Just b) = function "rtrim" a b
 rtrim a Nothing = function "rtrim" a
 
 
+-- | Corresponds to the @split_part@ function.
 splitPart :: Expr Text -> Expr Text -> Expr Int32 -> Expr Text
 splitPart = function "split_part"
 
 
+-- | Corresponds to the @strpos@ function.
 strpos :: Expr Text -> Expr Text -> Expr Int32
 strpos = function "strpos"
 
 
+-- | Corresponds to the @substr@ function.
 substr :: Expr Text -> Expr Int32 -> Maybe (Expr Int32) -> Expr Text
 substr a b (Just c) = function "substr" a b c
 substr a b Nothing = function "substr" a b
 
 
-toAscii :: Expr Text -> Expr Text -> Expr Text
-toAscii = function "toAscii"
-
-
-toHex :: Expr Int32 -> Expr Text
-toHex = function "toHex"
-
-
+-- | Corresponds to the @translate@ function.
 translate :: Expr Text -> Expr Text -> Expr Text -> Expr Text
 translate = function "translate"

src/Rel8/Expr/Time.hs

@@ -13,7 +13,7 @@ module Rel8.Expr.Time
   , diffTime
   , subtractTime
 
-  -- * Working with @NominalDiffTime@
+  -- * Working with @CalendarDiffTime@
   , scaleInterval
   , second, seconds
   , minute, minutes
@@ -35,7 +35,8 @@ import Rel8.Expr.Opaleye ( unsafeCastExpr, unsafeLiteral )
 
 -- time
 import Data.Time.Calendar ( Day )
-import Data.Time.Clock ( NominalDiffTime, UTCTime )
+import Data.Time.Clock ( UTCTime )
+import Data.Time.LocalTime ( CalendarDiffTime )
 
 
 -- | Corresponds to @date(now())@.
@@ -74,93 +75,93 @@ now = nullaryFunction "now"
 
 
 -- | Add a time interval to a point in time, yielding a new point in time.
-addTime :: Expr NominalDiffTime -> Expr UTCTime -> Expr UTCTime
+addTime :: Expr CalendarDiffTime -> Expr UTCTime -> Expr UTCTime
 addTime = flip (binaryOperator "+")
 
 
 -- | Find the duration between two times.
-diffTime :: Expr UTCTime -> Expr UTCTime -> Expr NominalDiffTime
+diffTime :: Expr UTCTime -> Expr UTCTime -> Expr CalendarDiffTime
 diffTime = binaryOperator "-"
 
 
 -- | Subtract a time interval from a point in time, yielding a new point in time.
-subtractTime :: Expr NominalDiffTime -> Expr UTCTime -> Expr UTCTime
+subtractTime :: Expr CalendarDiffTime -> Expr UTCTime -> Expr UTCTime
 subtractTime = flip (binaryOperator "-")
 
 
-scaleInterval :: Expr Double -> Expr NominalDiffTime -> Expr NominalDiffTime
+scaleInterval :: Expr Double -> Expr CalendarDiffTime -> Expr CalendarDiffTime
 scaleInterval = binaryOperator "*"
 
 
 -- | An interval of one second.
-second :: Expr NominalDiffTime
+second :: Expr CalendarDiffTime
 second = singleton "second"
 
 
 -- | Create a literal interval from a number of seconds.
-seconds :: Expr Double -> Expr NominalDiffTime
+seconds :: Expr Double -> Expr CalendarDiffTime
 seconds = (`scaleInterval` second)
 
 
 -- | An interval of one minute.
-minute :: Expr NominalDiffTime
+minute :: Expr CalendarDiffTime
 minute = singleton "minute"
 
 
 -- | Create a literal interval from a number of minutes.
-minutes :: Expr Double -> Expr NominalDiffTime
+minutes :: Expr Double -> Expr CalendarDiffTime
 minutes = (`scaleInterval` minute)
 
 
 -- | An interval of one hour.
-hour :: Expr NominalDiffTime
+hour :: Expr CalendarDiffTime
 hour = singleton "hour"
 
 
 -- | Create a literal interval from a number of hours.
-hours :: Expr Double -> Expr NominalDiffTime
+hours :: Expr Double -> Expr CalendarDiffTime
 hours = (`scaleInterval` hour)
 
 
 -- | An interval of one day.
-day :: Expr NominalDiffTime
+day :: Expr CalendarDiffTime
 day = singleton "day"
 
 
 -- | Create a literal interval from a number of days.
-days ::  Expr Double -> Expr NominalDiffTime
+days ::  Expr Double -> Expr CalendarDiffTime
 days = (`scaleInterval` day)
 
 
 -- | An interval of one week.
-week :: Expr NominalDiffTime
+week :: Expr CalendarDiffTime
 week = singleton "week"
 
 
 -- | Create a literal interval from a number of weeks.
-weeks ::  Expr Double -> Expr NominalDiffTime
+weeks ::  Expr Double -> Expr CalendarDiffTime
 weeks = (`scaleInterval` week)
 
 
 -- | An interval of one month.
-month :: Expr NominalDiffTime
+month :: Expr CalendarDiffTime
 month = singleton "month"
 
 
 -- | Create a literal interval from a number of months.
-months ::  Expr Double -> Expr NominalDiffTime
+months ::  Expr Double -> Expr CalendarDiffTime
 months = (`scaleInterval` month)
 
 
 -- | An interval of one year.
-year :: Expr NominalDiffTime
+year :: Expr CalendarDiffTime
 year = singleton "year"
 
 
 -- | Create a literal interval from a number of years.
-years ::  Expr Double -> Expr NominalDiffTime
+years ::  Expr Double -> Expr CalendarDiffTime
 years = (`scaleInterval` year)
 
 
-singleton :: String -> Expr NominalDiffTime
+singleton :: String -> Expr CalendarDiffTime
 singleton unit = unsafeLiteral $ "'1 " ++ unit ++ "'"

src/Rel8/Order.hs

@@ -19,21 +19,12 @@ import Data.Functor.Contravariant.Divisible ( Decidable, Divisible )
 import qualified Opaleye.Internal.Order as Opaleye
 
 
--- | An ordering expression for @a@. Primitive orderings are defined with 'asc'
--- and 'desc', and you can combine @Order@ via its various instances.
+-- | An ordering expression for @a@. Primitive orderings are defined with
+-- 'Rel8.asc' and 'Rel8.desc', and you can combine @Order@ via its various
+-- instances.
 --
 -- A common pattern is to use '<>' to combine multiple orderings in sequence,
--- and '>$<' (from 'Contravariant') to select individual columns. For example,
--- to sort a @Query@ on two columns, we could do:
---
--- >>> import Data.Functor.Contravariant ((>$<))
--- >>> :{
--- select c $ orderBy (mconcat [fst >$< asc, snd >$< desc]) $ do
---   x <- values [ lit x | x <- [1..3 :: Int32 ] ]
---   y <- values [ lit x | x <- [1..3 :: Int32 ] ]
---   return (x, y)
--- :}
--- [(1,3),(1,2),(1,1),(2,3),(2,2),(2,1),(3,3),(3,2),(3,1)]
+-- and '>$<' (from 'Contravariant') to select individual columns.
 type Order :: Type -> Type
 newtype Order a = Order (Opaleye.Order a)
   deriving newtype (Contravariant, Divisible, Decidable, Semigroup, Monoid)

src/Rel8/Query/Aggregate.hs

@@ -29,5 +29,8 @@ aggregate :: Query (Aggregate exprs) -> Query exprs
 aggregate = mapOpaleye (Opaleye.aggregate aggregator)
 
 
+-- | Count the number of rows returned by a query. Note that this is different
+-- from @countStar@, as even if the given query yields no rows, @countRows@
+-- will return @0@.
 countRows :: Query a -> Query (Expr Int64)
 countRows = fmap (maybeTable 0 id) . optional . aggregate . fmap (const countStar)

src/Rel8/Query/Distinct.hs

@@ -25,9 +25,6 @@ import Rel8.Table.Opaleye ( distinctspec, unpackspec )
 
 -- | Select all distinct rows from a query, removing duplicates.  @distinct q@
 -- is equivalent to the SQL statement @SELECT DISTINCT q@.
---
--- >>> select c $ distinct $ values [ lit True, lit True, lit False ]
--- [False,True]
 distinct :: EqTable a => Query a -> Query a
 distinct = mapOpaleye (Opaleye.distinctExplicit distinctspec)
 

src/Rel8/Query/Each.hs

@@ -22,11 +22,6 @@ import Rel8.Table.Opaleye ( table, unpackspec )
 
 -- | Select each row from a table definition. This is equivalent to @FROM
 -- table@.
---
--- >>> mapM_ print =<< select c (each projectSchema)
--- Project {projectAuthorId = 1, projectName = "rel8"}
--- Project {projectAuthorId = 2, projectName = "aeson"}
--- Project {projectAuthorId = 2, projectName = "text"}
 each :: Selects names exprs => TableSchema names -> Query exprs
 each =
   fmap fromColumns .

src/Rel8/Query/Exists.hs

@@ -24,18 +24,6 @@ import Rel8.Table.Maybe ( isJustTable )
 
 
 -- | Checks if a query returns at least one row.
---
--- >>> :{
--- mapM_ print =<< select c do
---   author <- each authorSchema
---   hasProjects <- exists do
---     project <- each projectSchema
---     where_ $ authorId author ==. projectAuthorId project
---   return (authorName author, hasProjects)
--- :}
--- ("Ollie",True)
--- ("Bryan O'Sullivan",True)
--- ("Emily Pillmore",False)
 exists :: Query a -> Query (Expr Bool)
 exists = fmap isJustTable . optional . whereExists
 -- FIXME: change this when b7aacc07c6392654cae439fc3b997620c3aa7a87 makes it
@@ -48,47 +36,33 @@ inQuery a = exists . (>>= filter (a ==:))
 
 -- | Produce the empty query if the given query returns no rows. @whereExists@
 -- is equivalent to @WHERE EXISTS@ in SQL.
---
--- >>> :{
--- select c do
---   author <- each authorSchema
---   whereExists do
---     project <- each projectSchema
---     where_ $ projectAuthorId project ==. authorId author
---   return $ authorName author
--- :}
--- ["Ollie","Bryan O'Sullivan"]
 whereExists :: Query a -> Query ()
 whereExists = mapOpaleye Opaleye.restrictExists
 
 
 -- | Produce the empty query if the given query returns rows. @whereNotExists@
 -- is equivalent to @WHERE NOT EXISTS@ in SQL.
---
--- >>> :{
--- select c do
---   author <- each authorSchema
---   whereNotExists do
---     project <- each projectSchema
---     where_ $ projectAuthorId project ==. authorId author
---   return $ authorName author
--- :}
--- ["Emily Pillmore"]
 whereNotExists :: Query a -> Query ()
 whereNotExists = mapOpaleye Opaleye.restrictNotExists
 
 
+-- | @with@ is similar to 'filter', but allows the predicate to be a full query.
+--
+-- @with f a = a <$ whereExists (f a)@, but this form matches 'filter'.
 with :: (a -> Query b) -> a -> Query a
 with f a = a <$ whereExists (f a)
 
 
-withBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a
+-- | Like @with@, but with a custom membership test.
+withBy :: (a -> b -> Expr Bool)  -> Query b -> a -> Query a
 withBy predicate bs = with $ \a -> bs >>= filter (predicate a)
 
 
+-- | Filter rows where @a -> Query b@ yields no rows.
 without :: (a -> Query b) -> a -> Query a
 without f a = a <$ whereNotExists (f a)
 
 
+-- | Like @without@, but with a custom membership test.
 withoutBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a
 withoutBy predicate bs = without $ \a -> bs >>= filter (predicate a)

src/Rel8/Query/Filter.hs

@@ -24,23 +24,12 @@ import Rel8.Query.Opaleye ( fromOpaleye )
 -- return @x@ unchanged when @f x@ is @True@. This is similar to
 -- 'Control.Monad.guard', but as the predicate is separate from the argument,
 -- it is easy to use in a pipeline of 'Query' transformations.
---
--- >>> select c $ values [ lit x | x <- [ 1..5 :: Int32 ] ] >>= filter (>. 3)
--- [4,5]
 filter :: (a -> Expr Bool) -> a -> Query a
 filter f a = a <$ where_ (f a)
 
 
 -- | Drop any rows that don't match a predicate.  @where_ expr@ is equivalent
 -- to the SQL @WHERE expr@.
---
--- >>> :{
--- select c $ do
---   x <- values [ lit x | x <- [ 1..5 :: Int32 ] ]
---   where_ $ x >. lit 2
---   return x
--- :}
--- [3,4,5]
 where_ :: Expr Bool -> Query ()
 where_ condition =
   fromOpaleye $ lmap (\_ -> toColumn $ toPrimExpr condition) Opaleye.restrict

src/Rel8/Query/Limit.hs

@@ -17,17 +17,11 @@ import Rel8.Query.Opaleye ( mapOpaleye )
 
 -- | @limit n@ select at most @n@ rows from a query.  @limit n@ is equivalent
 -- to the SQL @LIMIT n@.
---
--- >>> select c $ limit 3 $ values [ lit x | x <- [ 1..5 :: Int32 ] ]
--- [1,2,3]
 limit :: Word -> Query a -> Query a
 limit = mapOpaleye . Opaleye.limit . fromIntegral
 
 
 -- | @offset n@ drops the first @n@ rows from a query. @offset n@ is equivalent
 -- to the SQL @OFFSET n@.
---
--- >>> select c $ offset 3 $ values [ lit x | x <- [ 1..5 :: Int32 ] ]
--- [4,5]
 offset :: Word -> Query a -> Query a
 offset = mapOpaleye . Opaleye.offset . fromIntegral

src/Rel8/Query/Maybe.hs

@@ -25,14 +25,21 @@ import Rel8.Query.Filter ( where_ )
 import Rel8.Query.Opaleye ( mapOpaleye )
 import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
 import Rel8.Table.Opaleye ( unpackspec )
+import Rel8.Table.Tag ( Tag(..), fromExpr )
 
 
+-- | Convert a query that might return zero rows to a query that always returns
+-- at least one row.
+--
+-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
+-- JOIN@s.
 optional :: Query a -> Query (MaybeTable a)
 optional = mapOpaleye $ Opaleye.QueryArr . go
   where
-    go query (i, left, tag) = (MaybeTable t' a, join, Opaleye.next tag')
+    go query (i, left, tag) =
+      (MaybeTable (fromExpr t') a, join, Opaleye.next tag')
       where
-        (MaybeTable t a, right, tag') =
+        (MaybeTable Tag {expr = t} a, right, tag') =
           Opaleye.runSimpleQueryArr (pure <$> query) (i, tag)
         (t', bindings) = Opaleye.run $
           Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "maybe" tag') t
@@ -45,34 +52,6 @@ optional = mapOpaleye $ Opaleye.QueryArr . go
 -- This operation can be used to "undo" the effect of 'optional', which
 -- operationally is like turning a @LEFT JOIN@ back into a full @JOIN@.  You
 -- can think of this as analogous to 'Data.Maybe.catMaybes'.
---
--- To see this in action, first consider the following 'optional' query:
---
--- >>> :{
--- select c $ do
---   author <- each authorSchema
---   maybeRel8 <- optional $ 
---     each projectSchema 
---       >>= filter (\p -> projectAuthorId p ==. authorId author)
---       >>= filter (\p -> projectName p ==. "rel8")
---   return (authorName author, projectName <$> maybeRel8)
--- :}
--- [("Ollie",Just "rel8"),("Bryan O'Sullivan",Nothing),("Emily Pillmore",Nothing)]
---
--- Here @optional@ is acting as a @LEFT JOIN@. We can turn this into a proper
--- join by using @catMaybeTable@ to filter out rows where the join failed:
---
--- >>> :{
--- select c $ do
---   author <- each authorSchema
---   maybeRel8 <- optional $ 
---     each projectSchema 
---       >>= filter (\p -> projectAuthorId p ==. authorId author)
---       >>= filter (\p -> projectName p ==. "rel8")
---   rel8 <- catMaybeTable maybeRel8
---   return (authorName author, projectName rel8)
--- :}
--- [("Ollie","rel8")]
 catMaybeTable :: MaybeTable a -> Query a
 catMaybeTable ma@(MaybeTable _ a) = do
   where_ $ isJustTable ma
@@ -81,19 +60,11 @@ catMaybeTable ma@(MaybeTable _ a) = do
 
 -- | @bindMaybeTable f x@ is similar to the monadic bind (@>>=@) operation. It
 -- allows you to "extend" an optional query with another query. If either the
--- input or output are 'noTable', then the result is 'noTable'.
+-- input or output are 'Rel8.nothingTable', then the result is
+-- 'Rel8.nothingTable'.
 --
 -- This is similar to 'traverseMaybeTable', followed by a @join@ on the
 -- resulting @MaybeTable@s.
---
--- >>> select c $ bindMaybeTable (optional . values . pure . not_) =<< optional (values [lit True])
--- [Just False]
---
--- >>> select c $ bindMaybeTable (\_ -> return (noTable :: MaybeTable (Expr Bool))) =<< optional (values [lit True])
--- [Nothing]
---
--- >>> select c $ bindMaybeTable (optional . values . pure . not_) =<< return (noTable :: MaybeTable (Expr Bool))
--- [Nothing]
 bindMaybeTable :: Monad m
   => (a -> m (MaybeTable b)) -> MaybeTable a -> m (MaybeTable b)
 bindMaybeTable query (MaybeTable input a) = do
@@ -105,32 +76,12 @@ bindMaybeTable query (MaybeTable input a) = do
 -- to step through multiple @LEFT JOINs@.
 --
 -- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means
--- you also have the ability to "expand" one row into multiple rows.
---
--- >>> :{
--- duplicate :: Expr Bool -> Query (Expr Bool)
--- duplicate x = unionAll (return x) (return x)
--- :}
---
--- >>> select c $ traverseMaybeTable duplicate =<< optional (values [lit True])
--- [Just True,Just True]
---
--- Note that if the @a -> Query b@ function returns no rows, then the resulting
--- query will also have no rows:
---
--- >>> select c $ traverseMaybeTable (limit 0 . pure) =<< optional (values [lit True])
--- []
---
--- However, regardless of the given @a -> Query b@ function, if the input is
--- @noTable@, you will always get exactly one @noTable@ back:
---
--- >>> select c $ traverseMaybeTable duplicate (noTable :: MaybeTable (Expr Bool))
--- [Nothing]
---
--- >>> select c $ traverseMaybeTable (limit 0 . pure) (noTable :: MaybeTable (Expr Bool))
--- [Nothing]
+-- you also have the ability to "expand" one row into multiple rows.  If the 
+-- @a -> Query b@ function returns no rows, then the resulting query will also
+-- have no rows. However, regardless of the given @a -> Query b@ function, if
+-- the input is @noTable@, you will always get exactly one @noTable@ back.
 traverseMaybeTable :: (a -> Query b) -> MaybeTable a -> Query (MaybeTable b)
 traverseMaybeTable query ma@(MaybeTable input _) = do
   MaybeTable output b <- optional (query =<< catMaybeTable ma)
-  where_ $ output ==. input
+  where_ $ expr output ==. expr input
   pure $ MaybeTable input b

src/Rel8/Query/Null.hs

@@ -17,21 +17,6 @@ import Rel8.Query.Filter ( where_ )
 -- @null@s.
 --
 -- Corresponds to 'Data.Maybe.catMaybes'.
--- 
--- >>> select c $ pure (nullExpr :: Expr (Maybe Bool))
--- [Nothing]
--- 
--- >>> select c $ catNullable (nullExpr :: Expr (Maybe Bool))
--- []
--- 
--- >>> select c $ catNullable (lit (Just True))
--- [True]
--- 
--- Notice how in the last example a @Bool@ is returned (rather than @Maybe
--- Bool@):
--- 
--- >>> :t catNullable (lit (Just True))
--- catMaybe (lit (Just True)) :: Query (Expr Bool)
 catNullable :: Expr (Maybe a) -> Query (Expr a)
 catNullable a = do
   where_ $ isNonNull a

src/Rel8/Query/Set.hs

@@ -24,53 +24,35 @@ import Rel8.Table.Opaleye ( binaryspec )
 
 -- | Combine the results of two queries of the same type, collapsing
 -- duplicates.  @union a b@ is the same as the SQL statement @x UNION b@.
---
--- >>> select c $ values [lit True, lit True, lit False] `union` values [lit True]
--- [False,True]
 union :: EqTable a => Query a -> Query a -> Query a
 union = zipOpaleyeWith (Opaleye.unionExplicit binaryspec)
 
 
 -- | Combine the results of two queries of the same type, retaining duplicates.
 -- @unionAll a b@ is the same as the SQL statement @x UNION ALL b@.
---
--- >>> select c $ values [lit True, lit True, lit False] `unionAll` values [lit True]
--- [True,True,False,True]
 unionAll :: Table Expr a => Query a -> Query a -> Query a
 unionAll = zipOpaleyeWith (Opaleye.unionAllExplicit binaryspec)
 
 
 -- | Find the intersection of two queries, collapsing duplicates.  @intersect a
 -- b@ is the same as the SQL statement @x INTERSECT b@.
---
--- >>> select c $ values [lit True, lit True, lit False] `intersect` values [lit True]
--- [True]
 intersect :: EqTable a => Query a -> Query a -> Query a
 intersect = zipOpaleyeWith (Opaleye.intersectExplicit binaryspec)
 
 
 -- | Find the intersection of two queries, retaining duplicates.  @intersectAll
 -- a b@ is the same as the SQL statement @x INTERSECT ALL b@.
---
--- >>> select c $ values [lit True, lit True, lit False] `intersectAll` values [lit True, lit True]
--- [True,True]
 intersectAll :: EqTable a => Query a -> Query a -> Query a
 intersectAll = zipOpaleyeWith (Opaleye.intersectAllExplicit binaryspec)
 
 
 -- | Find the difference of two queries, collapsing duplicates @except a b@ is
 -- the same as the SQL statement @x INTERSECT b@.
---
--- >>> select c $ values [lit True, lit False, lit False] `except` values [lit True]
--- [False]
 except :: EqTable a => Query a -> Query a -> Query a
 except = zipOpaleyeWith (Opaleye.exceptExplicit binaryspec)
 
 
 -- | Find the difference of two queries, retaining duplicates.  @exceptAll a b@
 -- is the same as the SQL statement @x EXCEPT ALL b@.
---
--- >>> select c $ values [lit True, lit False, lit False] `exceptAll` values [lit True]
--- [False,False]
 exceptAll :: EqTable a => Query a -> Query a -> Query a
 exceptAll = zipOpaleyeWith (Opaleye.exceptAllExplicit binaryspec)

src/Rel8/Query/These.hs

@@ -33,6 +33,7 @@ import Rel8.Table ( Table )
 import Rel8.Table.Either ( EitherTable( EitherTable ) )
 import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
 import Rel8.Table.Opaleye ( unpackspec )
+import Rel8.Table.Tag ( Tag(..) )
 import Rel8.Table.These
   ( TheseTable( TheseTable )
   , hasHereTable, hasThereTable
@@ -104,9 +105,10 @@ keepThoseTable t@(TheseTable (MaybeTable _ a) (MaybeTable _ b)) = do
 loseThoseTable :: TheseTable a b -> Query (EitherTable a b)
 loseThoseTable t@(TheseTable (MaybeTable _ a) (MaybeTable _ b)) = do
   where_ $ not_ $ isThoseTable t
-  pure $ EitherTable tag a b
+  pure $ EitherTable result a b
   where
     tag = boolExpr (litExpr IsLeft) (litExpr IsRight) (isThatTable t)
+    result = (mempty `asTypeOf` result) {expr = tag}
 
 
 bindTheseTable :: (Table Expr a, Semigroup a, Monad m)

src/Rel8/Query/Values.hs

@@ -21,13 +21,7 @@ import Rel8.Table.Opaleye ( valuesspec )
 
 
 -- | Construct a query that returns the given input list of rows. This is like
--- folding a list of 'return' statements under 'union', but uses the SQL
+-- folding a list of 'return' statements under 'Rel8.union', but uses the SQL
 -- @VALUES@ expression for efficiency.
---
--- Typically @values@ will be used with 'lit':
---
--- >>> mapM_ Data.Text.IO.putStrLn =<< select c (values [ lit "Hello", lit "World!" ])
--- Hello
--- World!
 values :: (Table Expr a, Foldable f) => f a -> Query a
 values = fromOpaleye . Opaleye.valuesExplicit valuesspec . toList

src/Rel8/Schema/Column.hs

@@ -80,32 +80,6 @@ type family UnwrapDefault a where
 -- data types are single columns in queries. This type family has special
 -- support when a query is executed, allowing you to use a single data type for
 -- both query data and rows decoded to Haskell.
--- 
--- To understand why this type family is special, let's consider a simple
--- higher-kinded data type of Haskell packages:
--- 
--- >>> :{
--- data Package f = Package
---   { packageName   :: Column f Text
---   , packageAuthor :: Column f Text
---   }
--- :}
--- 
--- In queries, @f@ will be some type of 'Expr', and @Column Expr a@ reduces to
--- just @Expr a@:
--- 
--- >>> :t packageName (undefined :: Package Expr)
--- packageName (undefined :: Package Expr) :: Expr Text
--- 
--- When we 'select' queries of this type, @f@ will be instantiated as
--- @Identity@, at which point all wrapping entire disappears:
--- 
--- >>> :t packageName (undefined :: Package Identity)
--- packageName (undefined :: Package Identity) :: Text
--- 
--- In @rel8@ we try hard to always know what @f@ is, which means holes should
--- mention precise types, rather than the @Column@ type family. You should only
--- need to be aware of the type family when defining your table types.
 type Column :: K.Context -> Type -> Type
 type Column context a =
   Field context (GetLabel a)

src/Rel8/Schema/Context/Nullify.hs

@@ -2,6 +2,7 @@
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
 {-# language InstanceSigs #-}
+{-# language LambdaCase #-}
 {-# language MultiParamTypeClasses #-}
 {-# language NamedFieldPuns #-}
 {-# language ScopedTypeVariables #-}
@@ -12,29 +13,35 @@
 module Rel8.Schema.Context.Nullify
   ( Nullifiable( ConstrainTag, encodeTag, decodeTag, nullifier, unnullifier )
   , HNullifiable( HConstrainTag, hencodeTag, hdecodeTag, hnullifier, hunnullifier )
-  , unnull, runTag
+  , runTag, unnull
   )
 where
 
 -- base
 import Data.Kind ( Constraint, Type )
+import GHC.TypeLits ( KnownSymbol )
 import Prelude hiding ( null )
 
 -- opaleye
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 
 -- rel8
-import {-# SOURCE #-} Rel8.Expr ( Expr )
+import Rel8.Aggregate
+  ( Aggregate, Col(..)
+  , mapInputs
+  , unsafeMakeAggregate
+  )
+import Rel8.Expr ( Expr, Col(..) )
 import Rel8.Expr.Bool ( boolExpr )
 import Rel8.Expr.Null ( nullify, unsafeUnnullify )
-import Rel8.Expr.Opaleye ( fromPrimExpr )
-import Rel8.Kind.Labels ( KnownLabels )
+import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
 import Rel8.Kind.Necessity ( Necessity( Required ) )
-import Rel8.Schema.Context ( Interpretation, Col(..) )
+import Rel8.Schema.Context ( Interpretation )
 import qualified Rel8.Schema.Kind as K
+import Rel8.Schema.Name ( Name( Name ), Col(..) )
 import Rel8.Schema.Nullability
   ( Nullify
-  , Nullability( Nullable, NonNullable ), nullabilization
+  , Nullability( Nullable, NonNullable )
   , Sql
   )
 import Rel8.Schema.Dict ( Dict( Dict ) )
@@ -43,8 +50,7 @@ import Rel8.Schema.Spec.ConstrainDBType
   ( ConstrainDBType
   , dbTypeDict, dbTypeNullability, fromNullabilityDict
   )
-import Rel8.Type.Eq ( DBEq )
-import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
+import Rel8.Table.Tag ( Tag(..), Taggable, fromAggregate, fromExpr, fromName )
 
 
 type Nullifiable :: K.Context -> Constraint
@@ -52,25 +58,80 @@ class Interpretation context => Nullifiable context where
   type ConstrainTag context :: Type -> Constraint
   type ConstrainTag _context = DefaultConstrainTag
 
-  encodeTag :: (Sql (ConstrainTag context) a, Sql DBEq a, KnownLabels labels)
-    => Expr a
+  encodeTag ::
+    ( Sql (ConstrainTag context) a
+    , KnownSymbol label
+    , Taggable a
+    )
+    => Tag label a
     -> Col context ('Spec labels 'Required a)
 
-  decodeTag :: (Sql (ConstrainTag context) a, Sql DBMonoid a)
+  decodeTag ::
+    ( Sql (ConstrainTag context) a
+    , KnownSymbol label
+    , Taggable a
+    )
     => Col context ('Spec labels 'Required a)
-    -> Expr a
+    -> Tag label a
 
   nullifier :: ()
-    => Expr Bool
-    -> SSpec ('Spec labels necessity a)
-    -> Col context ('Spec labels necessity a)
-    -> Col context ('Spec labels necessity (Nullify a))
+    => Tag label a
+    -> (Expr a -> Expr Bool)
+    -> SSpec ('Spec labels necessity x)
+    -> Col context ('Spec labels necessity x)
+    -> Col context ('Spec labels necessity (Nullify x))
 
   unnullifier :: ()
-    => Expr Bool
-    -> SSpec ('Spec labels necessity a)
-    -> Col context ('Spec labels necessity (Nullify a))
-    -> Col context ('Spec labels necessity a)
+    => SSpec ('Spec labels necessity x)
+    -> Col context ('Spec labels necessity (Nullify x))
+    -> Col context ('Spec labels necessity x)
+
+
+instance Nullifiable Aggregate where
+  encodeTag Tag {aggregator, expr} =
+    Aggregation $ unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr
+
+  decodeTag (Aggregation aggregate) = fromAggregate aggregate
+
+  nullifier Tag {expr} test SSpec {nullability} (Aggregation aggregate) =
+    Aggregation $
+    mapInputs (toPrimExpr . runTag nullability condition . fromPrimExpr) $
+    runTag nullability condition <$> aggregate
+    where
+      condition = test expr
+
+  unnullifier SSpec {nullability} (Aggregation aggregate) =
+    Aggregation $ unnull nullability <$> aggregate
+
+  {-# INLINABLE encodeTag #-}
+  {-# INLINABLE decodeTag #-}
+  {-# INLINABLE nullifier #-}
+  {-# INLINABLE unnullifier #-}
+
+
+instance Nullifiable Expr where
+  encodeTag Tag {expr} = DB expr
+  decodeTag (DB a) = fromExpr a
+  nullifier Tag {expr} test SSpec {nullability} (DB a) =
+    DB $ runTag nullability (test expr) a
+  unnullifier SSpec {nullability} (DB a) = DB $ unnull nullability a
+
+  {-# INLINABLE encodeTag #-}
+  {-# INLINABLE decodeTag #-}
+  {-# INLINABLE nullifier #-}
+  {-# INLINABLE unnullifier #-}
+
+
+instance Nullifiable Name where
+  encodeTag Tag {name = Name name} = NameCol name
+  decodeTag (NameCol name) = fromName (Name name)
+  nullifier _ _ _ (NameCol name) = NameCol name
+  unnullifier _ (NameCol name) = NameCol name
+
+  {-# INLINABLE encodeTag #-}
+  {-# INLINABLE decodeTag #-}
+  {-# INLINABLE nullifier #-}
+  {-# INLINABLE unnullifier #-}
 
 
 runTag :: Nullability a -> Expr Bool -> Expr a -> Expr (Nullify a)
@@ -92,25 +153,25 @@ class HNullifiable context where
   type HConstrainTag context :: Type -> Constraint
   type HConstrainTag _context = DefaultConstrainTag
 
-  hencodeTag :: (Sql (HConstrainTag context) a, Sql DBEq a, KnownLabels labels)
-    => Expr a
+  hencodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)
+    => Tag label a
     -> context ('Spec labels 'Required a)
 
-  hdecodeTag :: (Sql (HConstrainTag context) a, Sql DBMonoid a)
+  hdecodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)
     => context ('Spec labels 'Required a)
-    -> Expr a
+    -> Tag label a
 
   hnullifier :: ()
-    => Expr Bool
-    -> SSpec ('Spec labels necessity a)
-    -> context ('Spec labels necessity a)
-    -> context ('Spec labels necessity (Nullify a))
+    => Tag label a
+    -> (Expr a -> Expr Bool)
+    -> SSpec ('Spec labels necessity x)
+    -> context ('Spec labels necessity x)
+    -> context ('Spec labels necessity (Nullify x))
 
   hunnullifier :: ()
-    => Expr Bool
-    -> SSpec ('Spec labels necessity a)
-    -> context ('Spec labels necessity (Nullify a))
-    -> context ('Spec labels necessity a)
+    => SSpec ('Spec labels necessity x)
+    -> context ('Spec labels necessity (Nullify x))
+    -> context ('Spec labels necessity x)
 
 
 instance Nullifiable context => HNullifiable (Col context) where
@@ -125,21 +186,14 @@ instance HNullifiable (Dict (ConstrainDBType constraint)) where
   type HConstrainTag (Dict (ConstrainDBType constraint)) = constraint
 
   hencodeTag _ = Dict
+  hdecodeTag = mempty
 
-  hdecodeTag :: forall a context labels. (Sql (HConstrainTag context) a, Sql DBMonoid a)
-    => context ('Spec labels 'Required a)
-    -> Expr a
-  hdecodeTag _ = case nullabilization @a of
-    Nullable -> nullify memptyExpr
-    NonNullable -> memptyExpr
-
-
-  hnullifier _ SSpec {} dict = case dbTypeDict dict of
+  hnullifier _ _ SSpec {} dict = case dbTypeDict dict of
     Dict -> case dbTypeNullability dict of
       Nullable -> Dict
       NonNullable -> Dict
 
-  hunnullifier _ SSpec {nullability} dict = case dbTypeDict dict of
+  hunnullifier SSpec {nullability} dict = case dbTypeDict dict of
     Dict -> case nullability of
       Nullable -> Dict
       NonNullable -> case dbTypeNullability dict of

src/Rel8/Schema/HTable/Type.hs

@@ -53,3 +53,9 @@ instance Sql DBType a => HTable (HType a) where
     , info = typeInformation
     , nullability = nullabilization
     }
+
+  {-# INLINABLE hfield #-}
+  {-# INLINABLE htabulate #-}
+  {-# INLINABLE htraverse #-}
+  {-# INLINABLE hdicts #-}
+  {-# INLINABLE hspecs #-}

src/Rel8/Schema/Insert.hs

@@ -47,6 +47,7 @@ import Rel8.Schema.Table ( TableSchema )
 import Rel8.Statement.Returning ( Returning )
 import Rel8.Table ( Table(..) )
 import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.Tag ( Tag(..), fromExpr )
 import Rel8.Type ( DBType )
 
 
@@ -134,14 +135,18 @@ instance Labelable Insert where
 
 
 instance Nullifiable Insert where
-  encodeTag = RequiredInsert
-  decodeTag (RequiredInsert a) = a
+  encodeTag = RequiredInsert . expr
+  decodeTag (RequiredInsert a) = fromExpr a
 
-  nullifier tag SSpec {nullability} = \case
-    RequiredInsert a -> RequiredInsert $ runTag nullability tag a
-    OptionalInsert ma -> OptionalInsert $ runTag nullability tag <$> ma
+  nullifier Tag {expr} test SSpec {nullability} = \case
+    RequiredInsert a ->
+      RequiredInsert $ runTag nullability condition a
+    OptionalInsert ma ->
+      OptionalInsert $ runTag nullability condition <$> ma
+    where
+      condition = test expr
 
-  unnullifier _ SSpec {nullability} = \case
+  unnullifier SSpec {nullability} = \case
     RequiredInsert a -> RequiredInsert $ unnull nullability a
     OptionalInsert ma -> OptionalInsert $ unnull nullability <$> ma
 
@@ -151,7 +156,6 @@ instance Nullifiable Insert where
   {-# INLINABLE unnullifier #-}
 
 
-
 -- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
 -- with the table @b@.
 type Inserts :: Type -> Type -> Constraint

src/Rel8/Schema/Name.hs

@@ -21,24 +21,18 @@ where
 
 -- base
 import Data.Functor.Identity ( Identity )
-import qualified Data.List.NonEmpty as NonEmpty
 import Data.Kind ( Constraint, Type )
 import Data.String ( IsString )
 import Prelude
 
 -- rel8
 import Rel8.Expr ( Expr )
-import Rel8.Kind.Labels ( KnownLabels, labelsSing, renderLabels )
 import Rel8.Opaque ( Opaque )
 import Rel8.Schema.Context ( Interpretation, Col )
 import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
-import Rel8.Schema.Context.Nullify
-  ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
-  )
 import Rel8.Schema.HTable.Type ( HType( HType ) )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Nullability ( Sql )
-import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Type ( DBType )
@@ -86,24 +80,6 @@ instance Labelable Name where
   unlabeler (NameCol a) = NameCol a
 
 
-instance Nullifiable Name where
-  encodeTag _ = nameFromLabel
-  decodeTag _ = mempty
-  nullifier _ _ (NameCol name) = NameCol name
-  unnullifier _ _ (NameCol name) = NameCol name
-
-  {-# INLINABLE encodeTag #-}
-  {-# INLINABLE decodeTag #-}
-  {-# INLINABLE nullifier #-}
-  {-# INLINABLE unnullifier #-}
-
-
-nameFromLabel :: forall labels necessity a.
-  KnownLabels labels => Col Name ('Spec labels necessity a)
-nameFromLabel = case labelsSing @labels of
-  labels -> NameCol (NonEmpty.last (renderLabels labels))
-
-
 -- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
 -- the 'Expr' columns in @b@.
 type Selects :: Type -> Type -> Constraint

src/Rel8/Schema/Nullability/Internal.hs

@@ -5,6 +5,7 @@
 {-# language FunctionalDependencies #-}
 {-# language GADTs #-}
 {-# language MultiParamTypeClasses #-}
+{-# language RankNTypes #-}
 {-# language QuantifiedConstraints #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
@@ -17,7 +18,7 @@ module Rel8.Schema.Nullability.Internal
   , Homonullable
   , Nullability( Nullable, NonNullable )
   , HasNullability, nullabilization
-  , Sql, toSql
+  , Sql, fromSql, mapSql, toSql
   )
 where
 
@@ -56,12 +57,15 @@ type Nullify :: Type -> Type
 type Nullify a = Maybe (Unnullify a)
 
 
+-- | @NotNull a@ means @a@ cannot take @null@ as a value.
 type NotNull :: Type -> Constraint
 class (HasNullability a, IsMaybe a ~ 'False) => NotNull a
 instance (HasNullability a, IsMaybe a ~ 'False) => NotNull a
 instance {-# OVERLAPPING #-} NotNull Opaque
 
 
+-- | @Homonullable a b@ means that both @a@ and @b@ can be @null@, or neither
+-- @a@ or @b@ can be @null@.
 type Homonullable :: Type -> Type -> Constraint
 class IsMaybe a ~ IsMaybe b => Homonullable a b
 instance IsMaybe a ~ IsMaybe b => Homonullable a b
@@ -92,6 +96,8 @@ instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where
   nullabilization' = Nullable
 
 
+-- | @HasNullability a@ means that @rel8@ is able to check if the type @a@ is a
+-- type that can take @null@ values or not.
 type HasNullability :: Type -> Constraint
 class HasNullability' (IsMaybe a) a => HasNullability a
 instance HasNullability' (IsMaybe a) a => HasNullability a
@@ -118,6 +124,19 @@ class
 instance (constraint (Unnullify a), HasNullability a) => Sql constraint a
 
 
+fromSql :: Dict (Sql constraint) a -> (Nullability a, Dict constraint (Unnullify a))
+fromSql Dict = (nullabilization, Dict)
+{-# INLINABLE fromSql #-}
+
+
+mapSql :: ()
+  => (forall x. Dict constraint x -> Dict constraint' x)
+  -> Dict (Sql constraint) a -> Dict (Sql constraint') a
+mapSql f dict = case fromSql dict of
+  (nullability, dict') -> toSql nullability (f dict')
+
+
 toSql :: Nullability a -> Dict constraint (Unnullify a) -> Dict (Sql constraint) a
 toSql NonNullable Dict = Dict
 toSql Nullable Dict = Dict
+{-# INLINABLE toSql #-}

src/Rel8/Schema/Table.hs

@@ -15,20 +15,7 @@ import Prelude
 -- the columns within this table.
 -- 
 -- For each selectable table in your database, you should provide a
--- @TableSchema@ in order to interact with the table via Rel8. For a table
--- storing a list of projects (as defined in the introduction):
--- 
--- >>> :{
--- projectSchema :: TableSchema (Project ColumnSchema)
--- projectSchema = TableSchema
---   { tableName = "project"
---   , tableSchema = Nothing -- Assumes that the 'project' table is reachable from your connection's search_path
---   , tableColumns = Project 
---       { projectAuthorId = "author_id"
---       , projectName = "name"
---       }
---   }
--- :}
+-- @TableSchema@ in order to interact with the table via Rel8.
 data TableSchema names = TableSchema
   { name :: String
     -- ^ The name of the table.

src/Rel8/Statement/Delete.hs

@@ -56,24 +56,6 @@ data Delete a where
 
 
 -- | Run a @DELETE@ statement.
---
--- >>> mapM_ print =<< select c (each projectSchema)
--- Project {projectAuthorId = 1, projectName = "rel8"}
--- Project {projectAuthorId = 2, projectName = "aeson"}
--- Project {projectAuthorId = 2, projectName = "text"}
---
--- >>> :{
--- delete c Delete
---   { from = projectSchema
---   , deleteWhere = \p -> projectName p ==. lit "rel8"
---   , returning = Projection projectName
---   }
--- :}
--- ["rel8"]
---
--- >>> mapM_ print =<< select c (each projectSchema)
--- Project {projectAuthorId = 2, projectName = "aeson"}
--- Project {projectAuthorId = 2, projectName = "text"}
 delete :: Connection -> Delete a -> IO a
 delete c Delete {from, deleteWhere, returning} =
   case returning of

src/Rel8/Statement/Insert.hs

@@ -39,16 +39,6 @@ import Data.Text.Encoding ( encodeUtf8 )
 
 
 -- | Run an @INSERT@ statement
---
--- >>> :{
--- insert c Insert
---   { into = authorSchema
---   , rows = [ lit Author{ authorName = "Gabriel Gonzales", authorId = AuthorId 4, authorUrl = Just "https://haskellforall.com" } ]
---   , onConflict = Abort
---   , returning = NumberOfRowsAffected
---   }
--- :}
--- 1
 insert :: Connection -> Insert a -> IO a
 insert c Insert {into, rows, onConflict, returning} =
   case (rows, returning) of

src/Rel8/Statement/Update.hs

@@ -61,26 +61,6 @@ data Update a where
 
 
 -- | Run an @UPDATE@ statement.
---
--- >>> mapM_ print =<< select c (each projectSchema)
--- Project {projectAuthorId = 1, projectName = "rel8"}
--- Project {projectAuthorId = 2, projectName = "aeson"}
--- Project {projectAuthorId = 2, projectName = "text"}
---
--- >>> :{
--- update c Update
---   { target = projectSchema
---   , set = \p -> p { projectName = "Rel8!" }
---   , updateWhere = \p -> projectName p ==. lit "rel8"
---   , returning = NumberOfRowsAffected
---   }
--- :}
--- 1
---
--- >>> mapM_ print =<< select c (each projectSchema)
--- Project {projectAuthorId = 2, projectName = "aeson"}
--- Project {projectAuthorId = 2, projectName = "text"}
--- Project {projectAuthorId = 1, projectName = "Rel8!"}
 update :: Connection -> Update a -> IO a
 update c Update {target, set, updateWhere, returning} =
   case returning of

src/Rel8/Statement/View.hs

@@ -31,6 +31,9 @@ import qualified Data.Text as Text
 import Data.Text.Encoding ( encodeUtf8 )
 
 
+-- | Given a 'TableSchema' and 'Query', @createView@ runs a @CREATE VIEW@
+-- statement that will save the given query as a view. This can be useful if
+-- you want to share Rel8 queries with other applications.
 createView :: Selects names exprs
   => TableSchema names -> Query exprs -> Connection -> IO ()
 createView (TableSchema name mschema names) query =

src/Rel8/Table.hs

@@ -42,11 +42,13 @@ import Rel8.Type ( DBType )
 -- types that have a finite number of columns. Each of these columns contains
 -- data under a shared context, and contexts describe how to interpret the
 -- metadata about a column to a particular Haskell type. In Rel8, we have
--- contexts for expressions (the 'Expr' context), aggregations (the 'Aggregate'
--- context), insert values (the 'Insert' contex), among others.
+-- contexts for expressions (the 'Rel8.Expr' context), aggregations (the
+-- 'Rel8.Aggregate' context), insert values (the 'Rel8.Insert' contex), among
+-- others.
 --
 -- In typical usage of Rel8 you don't need to derive instances of 'Table'
--- yourself, as anything that's an instance of 'Rel8able' is always a 'Table'.
+-- yourself, as anything that's an instance of 'Rel8.Rel8able' is always a
+-- 'Table'.
 type Table :: K.Context -> Type -> Constraint
 class (HTable (Columns a), context ~ Context a) => Table context a | a -> context where
   -- | The 'HTable' functor that describes the schema of this table.

src/Rel8/Table/Aggregate.hs

@@ -9,8 +9,6 @@ module Rel8.Table.Aggregate
   ( groupBy
   , listAgg
   , nonEmptyAgg
-  , sequenceAggregate
-  , distributeAggregate
   )
 where
 
@@ -19,7 +17,7 @@ import Data.Functor.Identity ( Identity( Identity ) )
 import Prelude
 
 -- rel8
-import Rel8.Aggregate ( Aggregate, Aggregates, Col(..) )
+import Rel8.Aggregate ( Aggregate, Col(..) )
 import Rel8.Expr ( Expr, Col(..) )
 import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
 import Rel8.Schema.Dict ( Dict( Dict ) )
@@ -69,11 +67,3 @@ nonEmptyAgg (toColumns -> exprs) = fromColumns $
   hvectorize
     (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
     (pure exprs)
-
-
-sequenceAggregate :: Aggregates aggregates exprs => aggregates -> Aggregate exprs
-sequenceAggregate = fromColumns . toColumns
-
-
-distributeAggregate :: Aggregates aggregates exprs => Aggregate exprs -> aggregates
-distributeAggregate = fromColumns . toColumns

src/Rel8/Table/Alternative.hs

@@ -20,8 +20,8 @@ import Rel8.Table ( Table )
 -- | Like 'Alt' in Haskell. This class is purely a Rel8 concept, and allows you
 -- to take a choice between two tables. See also 'AlternativeTable'.
 --
--- For example, using '<|>:' on 'MaybeTable' allows you to combine two tables
--- and to return the first one that is a "just" MaybeTable.
+-- For example, using '<|>:' on 'Rel8.MaybeTable' allows you to combine two
+-- tables and to return the first one that is a "just" MaybeTable.
 type AltTable :: (Type -> Type) -> Constraint
 class AltTable f where
   -- | An associative binary operation on 'Table's.

src/Rel8/Table/Bool.hs

@@ -18,14 +18,22 @@ import Rel8.Schema.HTable ( htabulate, hfield )
 import Rel8.Table ( Table, fromColumns, toColumns )
 
 
+-- | An if-then-else expression on tables.
+--
+-- @bool x y p@ returns @x@ if @p@ is @False@, and returns @y@ if @p@ is
+-- @True@.
 bool :: Table Expr a => a -> a -> Expr Bool -> a
 bool (toColumns -> false) (toColumns -> true) condition =
   fromColumns $ htabulate $ \field ->
     case (hfield false field, hfield true field) of
       (DB falseExpr, DB trueExpr) ->
         DB (boolExpr falseExpr trueExpr condition)
+{-# INLINABLE bool #-}
 
 
+-- | Produce a table expression from a list of alternatives. Returns the first
+-- table where the @Expr Bool@ expression is @True@. If no alternatives are
+-- true, the given default is returned.
 case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a
 case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =
   fromColumns $ htabulate $ \field -> case hfield fallback field of

src/Rel8/Table/Either.hs

@@ -15,6 +15,7 @@ module Rel8.Table.Either
   ( EitherTable(..)
   , eitherTable, leftTable, rightTable
   , isLeftTable, isRightTable
+  , aggregateEitherTable, nameEitherTable
   )
 where
 
@@ -25,7 +26,9 @@ import Data.Kind ( Type )
 import Prelude hiding ( undefined )
 
 -- rel8
+import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )
 import Rel8.Expr ( Expr )
+import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
 import Rel8.Expr.Serialize ( litExpr )
 import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )
 import Rel8.Schema.Context.Nullify
@@ -37,6 +40,7 @@ import Rel8.Schema.HTable.Either ( HEitherTable(..), HEitherNullifiable )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
+import Rel8.Schema.Name ( Name )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Bool ( bool )
 import Rel8.Table.Eq ( EqTable, eqTable )
@@ -45,21 +49,22 @@ import Rel8.Table.Lifted
   )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
 import Rel8.Table.Undefined ( undefined )
 import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )
 
 -- semigroupoids
-import Data.Functor.Apply ( Apply, (<.>) )
+import Data.Functor.Apply ( Apply, (<.>), liftF3 )
 import Data.Functor.Bind ( Bind, (>>-) )
 
 
 type EitherTable :: Type -> Type -> Type
 data EitherTable a b = EitherTable
-  { tag :: Expr EitherTag
+  { tag :: Tag "isRight" EitherTag
   , left :: a
   , right :: b
   }
-  deriving stock (Show, Functor)
+  deriving stock Functor
 
 
 instance Bifunctor EitherTable where
@@ -68,7 +73,7 @@ instance Bifunctor EitherTable where
 
 instance Table Expr a => Apply (EitherTable a) where
   EitherTable tag l1 f <.> EitherTable tag' l2 a =
-    EitherTable (tag <> tag') (bool l1 l2 (isLeft tag)) (f a)
+    EitherTable (tag <> tag') (bool l1 l2 (isLeft (expr tag))) (f a)
 
 
 instance Table Expr a => Applicative (EitherTable a) where
@@ -79,7 +84,7 @@ instance Table Expr a => Applicative (EitherTable a) where
 instance Table Expr a => Bind (EitherTable a) where
   EitherTable tag l1 a >>- f = case f a of
     EitherTable tag' l2 b ->
-      EitherTable (tag <> tag') (bool l1 l2 (isRight tag)) b
+      EitherTable (tag <> tag') (bool l1 l2 (isRight (expr tag))) b
 
 
 instance Table Expr a => Monad (EitherTable a) where
@@ -96,8 +101,8 @@ instance Table2 EitherTable where
 
   toColumns2 f g EitherTable {tag, left, right} = HEitherTable
     { htag
-    , hleft = hnullify (hnullifier (isLeft tag)) $ f left
-    , hright = hnullify (hnullifier (isRight tag)) $ g right
+    , hleft = hnullify (hnullifier tag isLeft) $ f left
+    , hright = hnullify (hnullifier tag isRight) $ g right
     }
     where
       htag = HIdentity (hencodeTag tag)
@@ -106,9 +111,9 @@ instance Table2 EitherTable where
     EitherTable
       { tag
       , left = f $ runIdentity $
-          hunnullify (\a -> pure . hunnullifier (isLeft tag) a) hleft
+          hunnullify (\a -> pure . hunnullifier a) hleft
       , right = g $ runIdentity $
-          hunnullify (\a -> pure . hunnullifier (isRight tag) a) hright
+          hunnullify (\a -> pure . hunnullifier a) hright
       }
     where
       tag = hdecodeTag $ unHIdentity htag
@@ -159,21 +164,21 @@ instance (OrdTable a, OrdTable b) => OrdTable (EitherTable a b) where
 
 
 isLeftTable :: EitherTable a b -> Expr Bool
-isLeftTable = isLeft . tag
+isLeftTable = isLeft . expr . tag
 
 
 isRightTable :: EitherTable a b -> Expr Bool
-isRightTable = isRight . tag
+isRightTable = isRight . expr . tag
 
 
 eitherTable :: Table Expr c
   => (a -> c) -> (b -> c) -> EitherTable a b -> c
 eitherTable f g EitherTable {tag, left, right} =
-  bool (f left) (g right) (isRight tag)
+  bool (f left) (g right) (isRight (expr tag))
 
 
 leftTable :: Table Expr b => a -> EitherTable a b
-leftTable a = EitherTable (litExpr IsLeft) a undefined
+leftTable a = EitherTable (fromExpr (litExpr IsLeft)) a undefined
 
 
 rightTable :: Table Expr a => b -> EitherTable a b
@@ -181,4 +186,20 @@ rightTable = rightTableWith undefined
 
 
 rightTableWith :: a -> b -> EitherTable a b
-rightTableWith = EitherTable (litExpr IsRight)
+rightTableWith = EitherTable (fromExpr (litExpr IsRight))
+
+
+aggregateEitherTable :: ()
+  => (a -> Aggregate c)
+  -> (b -> Aggregate d)
+  -> EitherTable a b
+  -> Aggregate (EitherTable c d)
+aggregateEitherTable f g EitherTable {tag, left, right} =
+  liftF3 EitherTable (tag <$ aggregate) (f left) (g right)
+  where
+    Tag {aggregator, expr} = tag
+    aggregate = unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr
+
+
+nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b
+nameEitherTable = EitherTable . fromName

src/Rel8/Table/Eq.hs

@@ -48,6 +48,9 @@ import Rel8.Type.Eq ( DBEq )
 import Rel8.Schema.Nullability ( Sql )
 
 
+-- | The class of 'Table's that can be compared for equality. Equality on
+-- tables is defined by equality of all columns all columns, so this class
+-- means "all columns in a 'Table' have an instance of 'DBEq'".
 type EqTable :: Type -> Constraint
 class Table Expr a => EqTable a where
   eqTable :: Columns a (Dict (ConstrainDBType DBEq))

src/Rel8/Table/Insert.hs

@@ -22,9 +22,9 @@ import Rel8.Table ( fromColumns, toColumns )
 
 
 -- | @toInsert@ converts a 'Table' of 'Expr's into a 'Table' that can be used
--- with 'insert'. This will override any columns that have default values to
--- use exactly what is given. If you want to use default values, you can either
--- override the result of @toInsert@, or use 'toInsertDefaults'.
+-- with 'Rel8.insert'. This will override any columns that have default values
+-- to use exactly what is given. If you want to use default values, you can
+-- either override the result of @toInsert@, or use 'toInsertDefaults'.
 toInsert :: Inserts exprs inserts => exprs -> inserts
 toInsert (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
   case hfield hspecs field of
@@ -35,8 +35,8 @@ toInsert (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
 
 
 -- | @toInsertDefaults@ converts a 'Table' of 'Expr's into a 'Table' that can
--- be used with 'insert'. Any columns that have a default value will override
--- whatever is in the input expression. 
+-- be used with 'Rel8.insert'. Any columns that have a default value will
+-- override whatever is in the input expression. 
 --
 -- One example where this is useful is for any table that has a special @id@
 -- column, which has a default value to draw a new value from a sequence. If we

src/Rel8/Table/List.hs

@@ -39,7 +39,7 @@ import Rel8.Table.Recontextualize ( Recontextualize )
 
 
 -- | A @ListTable@ value contains zero or more instances of @a@. You construct
--- @ListTable@s with 'many' or 'listAgg'.
+-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
 type ListTable :: Type -> Type
 newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
 

src/Rel8/Table/Maybe.hs

@@ -16,6 +16,8 @@ module Rel8.Table.Maybe
   , maybeTable, nothingTable, justTable
   , isNothingTable, isJustTable
   , ($?)
+  , aggregateMaybeTable
+  , nameMaybeTable
   )
 where
 
@@ -25,10 +27,11 @@ import Data.Kind ( Type )
 import Prelude hiding ( null, repeat, undefined, zipWith )
 
 -- rel8
+import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( boolExpr )
 import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )
-import Rel8.Expr.Serialize ( litExpr )
+import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
 import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )
 import Rel8.Schema.Context.Nullify
   ( Nullifiable, ConstrainTag
@@ -39,6 +42,7 @@ import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
 import Rel8.Schema.HTable.Maybe ( HMaybeTable(..), HMaybeNullifiable )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
+import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Nullability
   ( Nullify
   , Nullability( Nullable, NonNullable )
@@ -56,12 +60,13 @@ import Rel8.Table.Lifted
   )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
 import Rel8.Table.Undefined ( undefined )
 import Rel8.Type ( DBType )
-import Rel8.Type.Tag ( MaybeTag( IsJust ) )
+import Rel8.Type.Tag ( MaybeTag )
 
 -- semigroupoids
-import Data.Functor.Apply ( Apply, (<.>) )
+import Data.Functor.Apply ( Apply, (<.>), liftF2 )
 import Data.Functor.Bind ( Bind, (>>-) )
 
 
@@ -75,10 +80,10 @@ import Data.Functor.Bind ( Bind, (>>-) )
 -- a "nullTag" - to track whether or not the outer join produced any rows.
 type MaybeTable :: Type -> Type
 data MaybeTable a = MaybeTable
-  { tag :: Expr (Maybe MaybeTag)
+  { tag :: Tag "isJust" (Maybe MaybeTag)
   , just :: a
   }
-  deriving stock (Show, Functor)
+  deriving stock Functor
 
 
 instance Apply MaybeTable where
@@ -86,7 +91,7 @@ instance Apply MaybeTable where
 
 
 -- | Has the same behavior as the @Applicative@ instance for @Maybe@. See also:
--- 'traverseMaybeTable'.
+-- 'Rel8.traverseMaybeTable'.
 instance Applicative MaybeTable where
   (<*>) = (<.>)
   pure = justTable
@@ -98,14 +103,16 @@ instance Bind MaybeTable where
 
 
 -- | Has the same behavior as the @Monad@ instance for @Maybe@. See also:
--- 'bindMaybeTable'.
+-- 'Rel8.bindMaybeTable'.
 instance Monad MaybeTable where
   (>>=) = (>>-)
 
 
 instance AltTable MaybeTable where
   ma@(MaybeTable tag a) <|>: MaybeTable tag' b = MaybeTable
-    { tag = boolExpr tag tag' condition
+    { tag = (tag <> tag')
+        { expr = boolExpr (expr tag) (expr tag') condition
+        }
     , just = bool a b condition
     }
     where
@@ -130,7 +137,7 @@ instance Table1 MaybeTable where
 
   toColumns1 f MaybeTable {tag, just} = HMaybeTable
     { htag
-    , hjust = hnullify (hnullifier (isNonNull tag)) $ f just
+    , hjust = hnullify (hnullifier tag isNonNull) $ f just
     }
     where
       htag = HIdentity (hencodeTag tag)
@@ -138,7 +145,7 @@ instance Table1 MaybeTable where
   fromColumns1 f HMaybeTable {htag = HIdentity htag, hjust} = MaybeTable
     { tag
     , just = f $ runIdentity $
-        hunnullify (\a -> pure . hunnullifier (isNonNull tag) a) hjust
+        hunnullify (\a -> pure . hunnullifier a) hjust
     }
     where
       tag = hdecodeTag htag
@@ -175,38 +182,36 @@ instance OrdTable a => OrdTable (MaybeTable a) where
   ordTable = toColumns1 (hlabel hlabeler) (justTable (ordTable @a))
 
 
--- | Check if a @MaybeTable@ is absent of any row.. Like 'isNothing'.
+-- | Check if a @MaybeTable@ is absent of any row. Like 'Data.Maybe.isNothing'.
 isNothingTable :: MaybeTable a -> Expr Bool
-isNothingTable (MaybeTable tag _) = isNull tag
+isNothingTable (MaybeTable tag _) = isNull (expr tag)
 
 
--- | Check if a @MaybeTable@ contains a row. Like 'isJust'.
+-- | Check if a @MaybeTable@ contains a row. Like 'Data.Maybe.isJust'.
 isJustTable :: MaybeTable a -> Expr Bool
-isJustTable (MaybeTable tag _) = isNonNull tag
+isJustTable (MaybeTable tag _) = isNonNull (expr tag)
 
 
 -- | Perform case analysis on a 'MaybeTable'. Like 'maybe'.
 maybeTable :: Table Expr b => b -> (a -> b) -> MaybeTable a -> b
 maybeTable b f ma@(MaybeTable _ a) = bool (f a) b (isNothingTable ma)
+{-# INLINABLE maybeTable #-}
 
 
 -- | The null table. Like 'Nothing'.
 nothingTable :: Table Expr a => MaybeTable a
-nothingTable = MaybeTable null undefined
+nothingTable = MaybeTable (fromExpr null) undefined
 
 
 -- | Lift any table into 'MaybeTable'. Like 'Just'. Note you can also use
 -- 'pure'.
 justTable :: a -> MaybeTable a
-justTable = MaybeTable (nullify (litExpr IsJust))
+justTable = MaybeTable (fromExpr mempty)
 
 
 -- | Project a single expression out of a 'MaybeTable'. You can think of this
 -- operator like the '$' operator, but it also has the ability to return
 -- @null@.
---
--- >>> select c $ fmap (fst $?) (optional (values [lit (True, False)]))
--- [Just True]
 ($?) :: forall a b. Sql DBType b
   => (a -> Expr b) -> MaybeTable a -> Expr (Nullify b)
 f $? ma@(MaybeTable _ a) = case nullabilization @b of
@@ -214,3 +219,14 @@ f $? ma@(MaybeTable _ a) = case nullabilization @b of
   NonNullable -> boolExpr (nullify (f a)) null (isNothingTable ma)
 infixl 4 $?
 
+
+aggregateMaybeTable :: ()
+  => (a -> Aggregate b) -> MaybeTable a -> Aggregate (MaybeTable b)
+aggregateMaybeTable f MaybeTable {tag = tag@Tag {aggregator, expr}, just} =
+  liftF2 MaybeTable (tag <$ aggregate) (f just)
+  where
+    aggregate = unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr
+
+
+nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable a
+nameMaybeTable = MaybeTable . fromName

src/Rel8/Table/NonEmpty.hs

@@ -38,7 +38,7 @@ import Rel8.Table.Recontextualize ( Recontextualize )
 
 
 -- | A @NonEmptyTable@ value contains one or more instances of @a@. You
--- construct @NonEmptyTable@s with 'some' or 'nonEmptyAgg'.
+-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
 type NonEmptyTable :: Type -> Type
 newtype NonEmptyTable a =
   NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))

src/Rel8/Table/Opaleye.hs

@@ -35,8 +35,7 @@ import Data.Profunctor ( dimap, lmap )
 import Rel8.Aggregate ( Aggregate( Aggregate ) )
 import Rel8.Expr ( Expr, Col(..) )
 import Rel8.Expr.Opaleye
-  ( scastExpr
-  , fromPrimExpr, toPrimExpr
+  ( fromPrimExpr, toPrimExpr
   , traversePrimExpr
   , fromColumn, toColumn
   )
@@ -94,14 +93,14 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $
         name -> lmap (`hfield` field) (go specs name)
   where
     go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)
-    go SSpec {necessity, info} (NameCol name) = case necessity of
+    go SSpec {necessity} (NameCol name) = case necessity of
       SRequired ->
         lmap (\(RequiredInsert a) -> toColumn $ toPrimExpr a) $
-        DB . scastExpr info . fromPrimExpr . fromColumn <$>
+        DB . fromPrimExpr . fromColumn <$>
           Opaleye.requiredTableField name
       SOptional ->
         lmap (\(OptionalInsert ma) -> toColumn . toPrimExpr <$> ma) $
-        DB . scastExpr info . fromPrimExpr . fromColumn <$>
+        DB . fromPrimExpr . fromColumn <$>
           Opaleye.optionalTableField name
 
 

src/Rel8/Table/Serialize.hs

@@ -279,6 +279,8 @@ instance (ToExprs a exprs, a ~ FromExprs exprs) => Serializable exprs a
 instance {-# OVERLAPPING #-} Sql DBType a => Serializable (Expr a) a
 
 
+-- | Use @lit@ to turn literal Haskell values into expressions. @lit@ is
+-- capable of lifting single @Expr@s to full tables.
 lit :: forall exprs a. Serializable exprs a => a -> exprs
 lit = fromColumns . litHTable . toIdentity' @exprs
 

src/Rel8/Table/Tag.hs

@@ -0,0 +1,104 @@
+{-# language DataKinds #-}
+{-# language FlexibleInstances #-}
+{-# language GADTs #-}
+{-# language InstanceSigs #-}
+{-# language NamedFieldPuns #-}
+{-# language ScopedTypeVariables #-}
+{-# language StandaloneKindSignatures #-}
+{-# language TypeApplications #-}
+{-# language UndecidableInstances #-}
+
+module Rel8.Table.Tag
+  ( Tag(..), Taggable
+  , fromAggregate
+  , fromExpr
+  , fromName
+  )
+where
+
+-- base
+import Control.Applicative ( (<|>), empty )
+import Data.Kind ( Constraint, Type )
+import Data.Foldable ( fold )
+import Data.Monoid ( getFirst )
+import Data.Proxy ( Proxy( Proxy ) )
+import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
+import Prelude
+
+-- rel8
+import Rel8.Aggregate ( Aggregate, Aggregator, foldInputs )
+import Rel8.Expr ( Expr )
+import Rel8.Expr.Opaleye ( fromPrimExpr )
+import Rel8.Schema.Dict ( Dict( Dict ) )
+import Rel8.Schema.Name ( Name( Name ) )
+import Rel8.Schema.Nullability ( Sql, mapSql )
+import Rel8.Type.Monoid ( DBMonoid )
+import Rel8.Type.Semigroup ( DBSemigroup )
+
+
+type Tag :: Symbol -> Type -> Type
+data Tag label a = Tag
+  { expr :: Expr a
+  , aggregator :: Maybe Aggregator
+  , name :: Name a
+  }
+
+
+type Taggable :: Type -> Constraint
+class Taggable a where
+  tappend :: KnownSymbol label => Tag label a -> Tag label a -> Tag label a
+  tempty :: KnownSymbol label => Tag label a
+
+
+instance Sql DBMonoid a => Taggable a where
+  tappend :: forall label. KnownSymbol label
+    => Tag label a -> Tag label a -> Tag label a
+  tappend a b = Tag
+    { expr = case mapSql dbSemigroupFromDBMonoid (Dict @_ @a) of
+        Dict -> expr a <> expr b
+    , aggregator = aggregator a <|> aggregator b
+    , name = case (name a, symbolVal (Proxy @label)) of
+        (Name x, y)
+          | x == y -> name b
+          | otherwise -> name a
+    }
+  {-# INLINABLE tappend #-}
+
+  tempty :: forall label. KnownSymbol label => Tag label a
+  tempty = Tag
+    { expr = mempty
+    , aggregator = empty
+    , name = Name (symbolVal (Proxy @label))
+    }
+  {-# INLINABLE tempty #-}
+
+
+instance (KnownSymbol label, Taggable a) => Semigroup (Tag label a) where
+  (<>) = tappend
+
+
+instance (KnownSymbol label, Taggable a) => Monoid (Tag label a) where
+  mempty = tempty
+
+
+fromAggregate :: forall a label. (KnownSymbol label, Taggable a)
+  => Aggregate (Expr a) -> Tag label a
+fromAggregate = fold . getFirst . foldInputs go
+  where
+    go aggregator primExpr = pure $ (tempty @a @label)
+      { expr = fromPrimExpr primExpr
+      , aggregator
+      }
+
+
+fromExpr :: forall label a. (KnownSymbol label, Taggable a)
+  => Expr a -> Tag label a
+fromExpr expr = (tempty @a @label) {expr}
+
+
+fromName :: forall a label. Taggable a => Name a -> Tag label a
+fromName name = (tempty @a @"") {name}
+
+
+dbSemigroupFromDBMonoid :: Dict DBMonoid a -> Dict DBSemigroup a
+dbSemigroupFromDBMonoid Dict = Dict

src/Rel8/Table/These.hs

@@ -5,6 +5,7 @@
 {-# language FlexibleInstances #-}
 {-# language MultiParamTypeClasses #-}
 {-# language NamedFieldPuns #-}
+{-# language RecordWildCards #-}
 {-# language ScopedTypeVariables #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TupleSections #-}
@@ -18,6 +19,7 @@ module Rel8.Table.These
   , isThisTable, isThatTable, isThoseTable
   , hasHereTable, hasThereTable
   , justHereTable, justThereTable
+  , aggregateTheseTable, nameTheseTable
   )
 where
 
@@ -28,6 +30,7 @@ import Data.Kind ( Type )
 import Prelude hiding ( undefined )
 
 -- rel8
+import Rel8.Aggregate ( Aggregate )
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( (&&.), not_ )
 import Rel8.Expr.Null ( isNonNull )
@@ -42,6 +45,7 @@ import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.HTable.Maybe ( HMaybeNullifiable )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
 import Rel8.Schema.HTable.These ( HTheseTable(..) )
+import Rel8.Schema.Name ( Name  )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Eq ( EqTable, eqTable )
 import Rel8.Table.Lifted
@@ -51,14 +55,16 @@ import Rel8.Table.Maybe
   ( MaybeTable(..)
   , maybeTable, justTable, nothingTable
   , isJustTable
+  , aggregateMaybeTable, nameMaybeTable
   )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.Tag ( Tag(..) )
 import Rel8.Table.Undefined ( undefined )
 import Rel8.Type.Tag ( MaybeTag )
 
 -- semigroupoids
-import Data.Functor.Apply ( Apply, (<.>) )
+import Data.Functor.Apply ( Apply, (<.>), liftF2 )
 import Data.Functor.Bind ( Bind, (>>-) )
 
 
@@ -67,7 +73,7 @@ data TheseTable a b = TheseTable
   { here :: MaybeTable a
   , there :: MaybeTable b
   }
-  deriving stock (Show, Functor)
+  deriving stock Functor
 
 
 instance Bifunctor TheseTable where
@@ -116,10 +122,12 @@ instance Table2 TheseTable where
   type ConstrainHContext2 TheseTable = HMaybeNullifiable
 
   toColumns2 f g TheseTable {here, there} = HTheseTable
-    { hhereTag = HIdentity $ hencodeTag (tag here)
-    , hhere = hnullify (hnullifier (isNonNull (tag here))) $ f (just here)
-    , hthereTag = HIdentity $ hencodeTag (tag there)
-    , hthere = hnullify (hnullifier (isNonNull (tag there))) $ g (just there)
+    { hhereTag = HIdentity $ hencodeTag (toHereTag (tag here))
+    , hhere =
+        hnullify (hnullifier (tag here) isNonNull) $ f (just here)
+    , hthereTag = HIdentity $ hencodeTag (toThereTag (tag there))
+    , hthere =
+        hnullify (hnullifier (tag there) isNonNull) $ g (just there)
     }
 
   fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} =
@@ -132,7 +140,7 @@ instance Table2 TheseTable where
               { tag
               , just = f $
                   runIdentity $
-                  hunnullify (\a -> pure . hunnullifier (isNonNull tag) a)
+                  hunnullify (\a -> pure . hunnullifier a)
                   hhere
               }
       , there =
@@ -143,7 +151,7 @@ instance Table2 TheseTable where
               { tag
               , just = g $
                   runIdentity $
-                  hunnullify (\a -> pure . hunnullifier (isNonNull tag) a)
+                  hunnullify (\a -> pure . hunnullifier a)
                   hthere
               }
       }
@@ -192,6 +200,14 @@ instance (OrdTable a, OrdTable b) => OrdTable (TheseTable a b) where
       (thoseTable (ordTable @a) (ordTable @b))
 
 
+toHereTag :: Tag "isJust" a -> Tag "hasHere" a
+toHereTag Tag {..} = Tag {..}
+
+
+toThereTag :: Tag "isJust" a -> Tag "hasThere" a
+toThereTag Tag {..} = Tag {..}
+
+
 isThisTable :: TheseTable a b -> Expr Bool
 isThisTable a = hasHereTable a &&. not_ (hasThereTable a)
 
@@ -239,3 +255,25 @@ theseTable f g h TheseTable {here, there} =
     (maybeTable undefined f here)
     (\b -> maybeTable (g b) (`h` b) here)
     there
+
+
+aggregateTheseTable :: ()
+  => (a -> Aggregate c)
+  -> (b -> Aggregate d)
+  -> TheseTable a b
+  -> Aggregate (TheseTable c d)
+aggregateTheseTable f g TheseTable {here, there} =
+  liftF2 TheseTable (aggregateMaybeTable f here) (aggregateMaybeTable g there)
+
+
+nameTheseTable :: ()
+  => Name (Maybe MaybeTag)
+  -> Name (Maybe MaybeTag)
+  -> a
+  -> b
+  -> TheseTable a b
+nameTheseTable here there a b =
+  TheseTable
+    { here = nameMaybeTable here a
+    , there = nameMaybeTable there b
+    }

src/Rel8/Tabulate.hs

@@ -60,6 +60,13 @@ import qualified Data.Functor.Bind
 import Data.Semigroup.Traversable.Class ( bitraverse1 )
 
 
+-- | @'Tabulation' k a@ is denotionally a @MultiMap k a@ — a @Map@ where each
+-- key @k@ corresponds to potentially multiple @a@ (i.e., @'Query' a@).  This
+-- @MultiMap@ supports 'lookup' and other operations you would expect it to.
+--
+-- \"Identity\" 'Tabulation's are created using 'tabulate'. 'Tabulation's can
+-- be composed with 'Query's with 'prebind' or 'postbind' to form new
+-- 'Tabulation's.
 newtype Tabulation k a = Tabulation (k -> Query (Maybe k, a))
   deriving stock Functor
 
@@ -93,6 +100,16 @@ instance EqTable k => Monad (Tabulation k) where
               pure (mk', b)
 
 
+-- | This "undoes" 'fromQuery'.
+--
+-- @
+-- 'runTabulation' . 'fromQuery' = id
+-- 'fromQuery' . 'runTabulation' = id
+-- @
+--
+-- Note however that it produces nonsense when passed a 'Tabulation' that was
+-- made with from 'liftQuery' or 'pure'. In such cases the returned 'Query'
+-- will always produce zero rows.
 runTabulation :: EqTable k => Tabulation k a -> Query (k, a)
 runTabulation (Tabulation f) = do
   (mk, a) <- f i
@@ -111,14 +128,41 @@ liftQuery :: Query a -> Tabulation k a
 liftQuery query = Tabulation $ const $ fmap (Nothing,) query
 
 
+-- | 'tabulate' creates an \"identity\" @'Tabulation' k a@ that allows @a@ be
+-- indexed by one or more of its columns @k@. Some examples:
+--
+-- [Tabulation by primary key]:
+--   @
+--   projectsById :: Project 'Expr' -> 'Tabulation' ('Expr' ProjectId) (Project 'Expr')
+--   projectsById = 'tabulate' projectId
+--   @
+--
+--   Note: the nature of primary keys means that each key will be mapped to a
+--   singleton value in this case.
+--
+-- [Tabulation by other unique key]:
+--   @
+--   projectsByName :: Project 'Expr' -> 'Tabulation' ('Expr' Text) (Project 'Expr')
+--   projectsByName = 'tabulate' projectName
+--   @
+--
+-- [Tabulation by foreign key (tabulate a child table by parent key)]:
+--   @
+--   revisionsByProjectId :: Revision 'Expr' -> 'Tabulation' ('Expr' ProjectId) (Revision 'Expr')
+--   revisionsByProjectId = 'tabulate' revisionProjectId
+--   @
 tabulate :: (a -> k) -> a -> Tabulation k a
 tabulate key a = fromQuery $ pure (key a, a)
 
 
+-- | Like 'tabulate' but takes a monadic 'Query' function instead of a pure
+-- one.  This means you can filter rows while calculating the key, which is
+-- useful in conjunction with 'Rel8.Extra.catNulls'.
 tabulateA :: (a -> Query k) -> a -> Tabulation k a
 tabulateA key a = fromQuery $ (,a) <$> key a
 
 
+-- | Analgous to 'Data.Map.Strict.fromList'.
 fromQuery :: Query (k, a) -> Tabulation k a
 fromQuery = Tabulation . const . fmap (first Just)
 
@@ -133,6 +177,7 @@ ifilter f tabulation = snd <$> do
   filter (uncurry f) `postbind` indexed tabulation
 
 
+-- | Map a 'Query' over the input side of a 'Tabulation'. 
 prebind :: (a -> Tabulation k b) -> Query a -> Tabulation k b
 prebind f as = Tabulation $ \k -> do
   a <- as
@@ -141,6 +186,7 @@ prebind f as = Tabulation $ \k -> do
 infixr 1 `prebind`
 
 
+-- | Map a 'Query' over the output side of a 'Tabulation'.
 postbind :: (a -> Query b) -> Tabulation k a -> Tabulation k b
 postbind f (Tabulation as) = Tabulation $ \i -> do
   (k, a) <- as i
@@ -151,6 +197,8 @@ postbind f (Tabulation as) = Tabulation $ \i -> do
 infixr 1 `postbind`
 
 
+-- | Note that because 'Tabulation' is a @MultiMap@, the 'Query' returned by
+-- 'lookup' can and often does contain multiple results.
 lookup :: EqTable k => k -> Tabulation k a -> Query a
 lookup key (Tabulation query) = do
   (mk, a) <- query key
@@ -158,11 +206,19 @@ lookup key (Tabulation query) = do
   pure a
 
 
+-- | Analagous to
+-- [@align@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:align).
+--
+-- If 'zip' makes an @INNER JOIN@, then 'align' makes a @FULL OUTER JOIN@.
 align :: (EqTable k, Table Expr a, Table Expr b)
   => Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable a b)
 align = alignWith id
 
 
+-- | Analagous to
+-- [@alignWith@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:alignWith).
+--
+-- See 'zipWith' and 'align'.
 alignWith :: (EqTable k, Table Expr a, Table Expr b)
   => (TheseTable a b -> c)
   -> Tabulation k a -> Tabulation k b -> Tabulation k c
@@ -177,27 +233,73 @@ alignWith f kas kbs = do
     pure (k', f tab)
 
 
+-- | If 'zip' makes an @INNER JOIN@, then 'leftAlign' makes a @LEFT JOIN@.
+-- This means it will return at least one row for every row in the left
+-- 'Tabulation', even if there is no corresponding row in the right (hence the
+-- 'Rel8.MaybeTable').
+--
+-- Analagous to
+-- [@rpadZip@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:rpadZip).
 leftAlign :: EqTable k
   => Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable b)
 leftAlign = leftAlignWith (,)
 
 
+-- | See 'zipWith' and 'leftAlign'.
+--
+-- Analagous to
+-- [@rpadZipWith@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:rpadZipWith).
 leftAlignWith :: EqTable k
   => (a -> MaybeTable b -> c)
   -> Tabulation k a -> Tabulation k b -> Tabulation k c
 leftAlignWith f left right = liftA2 f left (optionalTabulation right)
 
 
+-- | Analagous to
+-- [@zip@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:zip).
+--
+-- There are multiple correct ways of understanding what this does.
+--
+-- You can think of it as @'Data.Map.Strict.intersectionWith'
+-- ('Control.Applicative.liftA2' (,))@.  That is, @intersect@ the two
+-- `Tabulation`s by matching their keys together (with 'Rel8.==:'), and combine
+-- their values (remembering that 'Tabulation' is a 'MultiMap' so that the
+-- values are keys) by getting their cartesian product.
+--
+-- You can think of it as performing a cross product of the underlying 'Query's
+-- of the given 'Tabulation's and filtering the results for 'match'ing keys.
+--
+-- You can think of it as a natural join in SQL terms.
+--
+-- The size of the resulting 'Tabulation' will be \(\sum_{k} min(n_k, m_k) \)
+-- in terms of the number of keys, but \(\sum_{k} n_k \times m_k\) in terms of
+-- the number of values.
 zip :: EqTable k
   => Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
 zip = zipWith (,)
 
 
+-- | Analagous to
+-- [@zipWith@](https://hackage.haskell.org/package/semialign/docs/Data-Semialign.html#v:zipWith).
+--
+-- See 'zip'.
 zipWith :: EqTable k
   => (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
 zipWith = liftA2
 
 
+-- | 'similarity' returns all the entries in the left 'Tabulation' that have a
+-- corresponding entry in the right 'Tabulation'. This corresponds to a
+-- semijoin in relational algebra.
+--
+-- This differs from @'zipWith' const x y@ when the right 'Tabulation' @y@
+-- contains an entry with multiple rows. For 'similarity', the entries in the
+-- resulting 'Tabulation' will contain the same number of rows as their
+-- respective entries in the left 'Tabulation' @x@. With `zipWith const x y`,
+-- each entry would contain the /product/ of the number of rows of their
+-- respective entries in @x@ and @y@.
+--
+-- See 'Rel8.with'.
 similarity :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
 similarity kas kbs = do
   as <- toQuery kas
@@ -205,6 +307,11 @@ similarity kas kbs = do
   fromQuery $ as >>= withBy (\(k, _) (l, _) -> k ==: l) bs
 
 
+-- | 'difference' returns all the entries in the left 'Tabulation' that don't
+-- exist in the right 'Tabulation'. This corresponds to an antijoin in
+-- relational algebra.
+--
+-- See 'Rel8.without'.
 difference :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
 difference kas kbs = do
   as <- toQuery kas

src/Rel8/Type.hs

@@ -58,8 +58,12 @@ import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )
 
 -- time
 import Data.Time.Calendar ( Day )
-import Data.Time.Clock ( DiffTime, NominalDiffTime, UTCTime )
-import Data.Time.LocalTime ( LocalTime, TimeOfDay )
+import Data.Time.Clock ( UTCTime )
+import Data.Time.LocalTime
+  ( CalendarDiffTime( CalendarDiffTime )
+  , LocalTime
+  , TimeOfDay
+  )
 import Data.Time.Format ( formatTime, defaultTimeLocale )
 
 -- uuid
@@ -75,18 +79,6 @@ import qualified Data.UUID as UUID
 -- should only need to derive instances of this class for custom database
 -- types, such as types defined in PostgreSQL extensions, or custom domain
 -- types.
--- 
--- [ Creating @DBType@s using @newtype@ ]
--- 
--- Generalized newtype deriving can be used when you want use a @newtype@
--- around a database type for clarity and accuracy in your Haskell code. A
--- common example is to @newtype@ row id types:
--- 
--- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType)
--- 
--- You can now write queries using @UserId@ instead of @Int32@, which may help
--- avoid making bad joins. However, when SQL is generated, it will be as if you
--- just used integers (the type distinction does not impact query generation).
 type DBType :: Type -> Constraint
 class NotNull a => DBType a where
   typeInformation :: TypeInformation a
@@ -98,7 +90,6 @@ instance DBType Bool where
     { encode = Opaleye.ConstExpr . Opaleye.BoolLit
     , decode = Hasql.bool
     , typeName = "bool"
-    , out = id
     }
 
 
@@ -108,7 +99,6 @@ instance DBType Char where
     { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure
     , decode = Hasql.char
     , typeName = "char"
-    , out = id
     }
 
 
@@ -118,7 +108,6 @@ instance DBType Int16 where
     { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
     , decode = Hasql.int2
     , typeName = "int2"
-    , out = id
     }
 
 
@@ -128,7 +117,6 @@ instance DBType Int32 where
     { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
     , decode = Hasql.int4
     , typeName = "int4"
-    , out = id
     }
 
 
@@ -138,7 +126,6 @@ instance DBType Int64 where
     { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger
     , decode = Hasql.int8
     , typeName = "int8"
-    , out = id
     }
 
 
@@ -148,7 +135,6 @@ instance DBType Float where
     { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
     , decode = Hasql.float4
     , typeName = "float4"
-    , out = id
     }
 
 
@@ -158,7 +144,6 @@ instance DBType Double where
     { encode = Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
     , decode = Hasql.float8
     , typeName = "float8"
-    , out = id
     }
 
 
@@ -168,7 +153,6 @@ instance DBType Scientific where
     { encode = Opaleye.ConstExpr . Opaleye.NumericLit
     , decode = Hasql.numeric
     , typeName = "numeric"
-    , out = id
     }
 
 
@@ -180,7 +164,6 @@ instance DBType UTCTime where
         formatTime defaultTimeLocale "'%FT%T%QZ'"
     , decode = Hasql.timestamptz
     , typeName = "timestamptz"
-    , out = id
     }
 
 
@@ -192,7 +175,6 @@ instance DBType Day where
         formatTime defaultTimeLocale "'%F'"
     , decode = Hasql.date
     , typeName = "date"
-    , out = id
     }
 
 
@@ -204,7 +186,6 @@ instance DBType LocalTime where
         formatTime defaultTimeLocale "'%FT%T%Q'"
     , decode = Hasql.timestamp
     , typeName = "timestamp"
-    , out = id
     }
 
 
@@ -216,34 +197,26 @@ instance DBType TimeOfDay where
         formatTime defaultTimeLocale "'%T%Q'"
     , decode = Hasql.time
     , typeName = "time"
-    , out = id
     }
 
 
 -- | Corresponds to @interval@
-instance DBType DiffTime where
+instance DBType CalendarDiffTime where
   typeInformation = TypeInformation
     { encode =
         Opaleye.ConstExpr . Opaleye.OtherLit .
-        formatTime defaultTimeLocale "'%0Es'"
-    , decode = Hasql.interval
+        formatTime defaultTimeLocale "'%bmon %0Es'"
+    , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval
     , typeName = "interval"
-    , out = id
     }
 
 
-instance DBType NominalDiffTime where
-  typeInformation =
-    mapTypeInformation @DiffTime realToFrac realToFrac typeInformation
-
-
 -- | Corresponds to @text@
 instance DBType Text where
   typeInformation = TypeInformation
     { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack
     , decode = Hasql.text
     , typeName = "text"
-    , out = id
     }
 
 
@@ -273,7 +246,6 @@ instance DBType ByteString where
     { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit
     , decode = Hasql.bytea
     , typeName = "bytea"
-    , out = id
     }
 
 
@@ -290,7 +262,6 @@ instance DBType UUID where
     { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString
     , decode = Hasql.uuid
     , typeName = "uuid"
-    , out = id
     }
 
 
@@ -303,7 +274,6 @@ instance DBType Value where
         Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode
     , decode = Hasql.jsonb
     , typeName = "jsonb"
-    , out = id
     }
 
 

src/Rel8/Type/Array.hs

@@ -40,15 +40,14 @@ listTypeInformation :: ()
   -> TypeInformation [a]
 listTypeInformation nullability info = 
   case info of
-    TypeInformation{ encode, decode, out } -> TypeInformation
+    TypeInformation{ encode, decode } -> TypeInformation
       { decode = row $ case nullability of
-          Nullable -> Hasql.listArray (Hasql.nullable (out <$> decode))
-          NonNullable -> Hasql.listArray (Hasql.nonNullable (out <$> decode))
+          Nullable -> Hasql.listArray (Hasql.nullable decode)
+          NonNullable -> Hasql.listArray (Hasql.nonNullable decode)
       , encode = case nullability of
           Nullable -> array info . fmap (maybe null encode)
           NonNullable -> array info . fmap encode
       , typeName = "record"
-      , out = id
       }
   where
     row = Hasql.composite . Hasql.field . Hasql.nonNullable

src/Rel8/Type/Array1D.hs

@@ -66,6 +66,7 @@ import Data.Semialign ( Semialign )
 import Data.Zip ( Repeat, Unzip, Zip )
 
 
+-- | A one dimensional array.
 newtype Array1D a = Array1D [a]
   deriving stock Traversable
   deriving newtype
@@ -98,15 +99,14 @@ array1DTypeInformation :: IsArray1D (Unnullify a) ~ 'False
   -> TypeInformation (Array1D a)
 array1DTypeInformation nullability info = 
   case info of
-    TypeInformation{ encode, decode, typeName, out } -> TypeInformation
+    TypeInformation{ encode, decode, typeName } -> TypeInformation
       { decode = case nullability of
-          Nullable -> Array1D <$> Hasql.listArray (Hasql.nullable (out <$> decode))
-          NonNullable -> Array1D <$> Hasql.listArray (Hasql.nonNullable (out <$> decode))
+          Nullable -> Array1D <$> Hasql.listArray (Hasql.nullable decode)
+          NonNullable -> Array1D <$> Hasql.listArray (Hasql.nonNullable decode)
       , encode = case nullability of
           Nullable -> Opaleye.ArrayExpr . fmap (maybe null encode) . getArray1D
           NonNullable -> Opaleye.ArrayExpr . fmap encode . getArray1D
       , typeName = typeName <> "[]"
-      , out = id
       }
   where
     null = Opaleye.ConstExpr Opaleye.NullLit

src/Rel8/Type/Eq.hs

@@ -39,8 +39,8 @@ import qualified Data.Text.Lazy as Lazy ( Text )
 
 -- time
 import Data.Time.Calendar ( Day )
-import Data.Time.Clock ( UTCTime, DiffTime, NominalDiffTime )
-import Data.Time.LocalTime ( TimeOfDay, LocalTime )
+import Data.Time.Clock ( UTCTime )
+import Data.Time.LocalTime ( CalendarDiffTime, LocalTime, TimeOfDay )
 
 -- uuid
 import Data.UUID ( UUID )
@@ -49,36 +49,6 @@ import Data.UUID ( UUID )
 -- | Database types that can be compared for equality in queries. If a type is
 -- an instance of 'DBEq', it means we can compare expressions for equality
 -- using the SQL @=@ operator.
--- 
--- [ @DBEq@ with @newtype@s ]
--- 
--- Like with 'Rel8.DBType', @DBEq@ plays well with generalized newtype
--- deriving.  The example given for @DBType@ added a @UserId@ @newtype@, but
--- without a @DBEq@ instance won't actually be able to use that in joins or
--- where-clauses, because it lacks equality. We can add this by changing our
--- @newtype@ definition to:
--- 
--- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType, DBEq)
--- 
--- This will re-use the equality logic for @Int32@, which is to just use the
--- @=@ operator.
--- 
--- [ @DBEq@ with @DeriveAnyType@ ]
--- 
--- You can also use @DBEq@ with the @DeriveAnyType@ extension to easily add
--- equality to your type, assuming that @=@ is sufficient on @DBType@ encoded
--- values. Extending the example from 'Rel8.ReadShow''s 'Rel8.DBType' instance,
--- we could add equality to @Color@ by writing:
--- 
--- >>> :{
--- data Color = Red | Green | Blue | Purple | Gold
---   deriving (Generic, Show, Read, DBEq)
---   deriving DBType via ReadShow Color
--- :}
--- 
--- This means @Color@s will be treated as the literal strings @"Red"@,
--- @"Green"@, etc, in the database, and they can be compared for equality by
--- just using @=@.
 type DBEq :: Type -> Constraint
 class DBType a => DBEq a
 
@@ -95,8 +65,7 @@ instance DBEq UTCTime
 instance DBEq Day
 instance DBEq LocalTime
 instance DBEq TimeOfDay
-instance DBEq DiffTime
-instance DBEq NominalDiffTime
+instance DBEq CalendarDiffTime
 instance DBEq Text
 instance DBEq Lazy.Text
 instance DBEq (CI Text)

src/Rel8/Type/Information.hs

@@ -28,23 +28,19 @@ import qualified Data.Text as Text
 -- from database queries. The @typeName@ is the name of the type in the
 -- database, which is used to accurately type literals. 
 type TypeInformation :: Type -> Type
-data TypeInformation a where
-  TypeInformation ::
-    { encode :: a -> Opaleye.PrimExpr
-      -- ^ How to encode a single Haskell value as a SQL expression.
-    , decode :: Hasql.Value x
-      -- ^ How to deserialize a single result back to Haskell.
-    , typeName :: String
-      -- ^ The name of the SQL type.
-    , out :: x -> a
-      -- ^ A final output function - usually this will just be 'id'. This is
-      -- needed to allow @TypeInformation@s to be coerced.
-    } -> TypeInformation a
+data TypeInformation a = TypeInformation
+  { encode :: a -> Opaleye.PrimExpr
+    -- ^ How to encode a single Haskell value as a SQL expression.
+  , decode :: Hasql.Value a
+    -- ^ How to deserialize a single result back to Haskell.
+  , typeName :: String
+    -- ^ The name of the SQL type.
+  }
 
 
 -- | Simultaneously map over how a type is both encoded and decoded, while
 -- retaining the name of the type. This operation is useful if you want to
--- essentially @newtype@ another 'DBType'.
+-- essentially @newtype@ another 'Rel8.DBType'.
 -- 
 -- The mapping is required to be total. If you have a partial mapping, see
 -- 'parseTypeInformation'.
@@ -60,31 +56,12 @@ mapTypeInformation = parseTypeInformation . fmap pure
 -- a given 'TypeInformation'. The parser is applied when deserializing rows
 -- returned - the encoder assumes that the input data is already in the
 -- appropriate form.
--- 
--- One example where this may be useful is with a database that stores data in
--- some legacy encoding:
--- 
--- >>> import Data.Text (Text)
--- 
--- >>> data Color = Red | Green | Blue
--- >>> :{
--- instance DBType Color where
---   typeInformation = parseTypeInformation parseLegacy toLegacy typeInformation
---     where
---       parseLegacy :: Text -> Either String Color
---       parseLegacy "red"   = Right Red
---       parseLegacy "green" = Right Green
---       parseLegacy _       = Left "Unexpected Color"
---       toLegacy Red   = "red"
---       toLegacy Green = "green"
--- :}
 parseTypeInformation :: ()
   => (a -> Either String b) -> (b -> a)
   -> TypeInformation a -> TypeInformation b
-parseTypeInformation to from TypeInformation {encode, decode, typeName, out} =
+parseTypeInformation to from TypeInformation {encode, decode, typeName} =
   TypeInformation
     { encode = encode . from
-    , decode = Hasql.refine (first Text.pack . to) (out <$> decode)
+    , decode = Hasql.refine (first Text.pack . to) decode
     , typeName
-    , out = id
     }

src/Rel8/Type/JSONBEncoded.hs

@@ -19,7 +19,7 @@ import Rel8.Type.Information ( TypeInformation(..) )
 import Data.Text ( pack )
 
 
--- | Like 'JSONEncoded', but works for @jsonb@ columns.
+-- | Like 'Rel8.JSONEncoded', but works for @jsonb@ columns.
 newtype JSONBEncoded a = JSONBEncoded { fromJSONBEncoded :: a }
 
 
@@ -28,5 +28,4 @@ instance (FromJSON a, ToJSON a) => DBType (JSONBEncoded a) where
     { encode = encode typeInformation . toJSON . fromJSONBEncoded
     , decode = Hasql.refine (first pack . fmap JSONBEncoded . parseEither parseJSON) Hasql.jsonb
     , typeName = "jsonb"
-    , out = id
     }

src/Rel8/Type/JSONEncoded.hs

@@ -15,19 +15,6 @@ import Rel8.Type.Information ( parseTypeInformation )
 -- | A deriving-via helper type for column types that store a Haskell value
 -- using a JSON encoding described by @aeson@'s 'ToJSON' and 'FromJSON' type
 -- classes.
--- 
--- The declaration:
--- 
--- >>> import Data.Aeson
--- 
--- >>> :{
--- data Pet = Pet { petName :: String, petAge :: Int }
---   deriving (Generic, ToJSON, FromJSON)
---   deriving PrimitiveType via JSONEncoded Pet
--- :}
--- 
--- will allow you to store @Pet@ values in a single SQL column (stored as
--- @json@ values).
 newtype JSONEncoded a = JSONEncoded { fromJSONEncoded :: a }
 
 

src/Rel8/Type/Monoid.hs

@@ -39,11 +39,11 @@ import Data.Text ( Text )
 import qualified Data.Text.Lazy as Lazy ( Text )
 
 -- time
-import Data.Time.Clock ( DiffTime, NominalDiffTime )
+import Data.Time.LocalTime ( CalendarDiffTime( CalendarDiffTime ) )
 
 
--- | The class of 'DBType's that form a semigroup. This class is purely a Rel8
--- concept, and exists to mirror the 'Monoid' class.
+-- | The class of 'Rel8.DBType's that form a semigroup. This class is purely a
+-- Rel8 concept, and exists to mirror the 'Monoid' class.
 type DBMonoid :: Type -> Constraint
 class DBSemigroup a => DBMonoid a where
   -- The identity for '<>.'
@@ -54,12 +54,8 @@ instance Sql DBType a => DBMonoid [a] where
   memptyExpr = sempty nullabilization typeInformation
 
 
-instance DBMonoid DiffTime where
-  memptyExpr = litExpr 0
-
-
-instance DBMonoid NominalDiffTime where
-  memptyExpr = litExpr 0
+instance DBMonoid CalendarDiffTime where
+  memptyExpr = litExpr (CalendarDiffTime 0 0)
 
 
 instance DBMonoid Text where

src/Rel8/Type/Num.hs

@@ -40,6 +40,9 @@ instance {-# INCOHERENT #-} (HasNullability a, DBNum (Unnullify a)) =>
   Sql DBNum a
 
 
+-- | The class of database types that can be coerced to from integral
+-- expressions. This is a Rel8 concept, and allows us to provide
+-- 'fromIntegral'.
 type DBIntegral :: Type -> Constraint
 class DBNum a => DBIntegral a
 instance DBIntegral Int16

src/Rel8/Type/Ord.hs

@@ -37,8 +37,8 @@ import qualified Data.Text.Lazy as Lazy ( Text )
 
 -- time
 import Data.Time.Calendar ( Day )
-import Data.Time.Clock ( DiffTime, NominalDiffTime, UTCTime )
-import Data.Time.LocalTime ( TimeOfDay, LocalTime )
+import Data.Time.Clock ( UTCTime )
+import Data.Time.LocalTime ( CalendarDiffTime, LocalTime, TimeOfDay )
 
 -- uuid
 import Data.UUID ( UUID )
@@ -60,8 +60,7 @@ instance DBOrd UTCTime
 instance DBOrd Day
 instance DBOrd LocalTime
 instance DBOrd TimeOfDay
-instance DBOrd DiffTime
-instance DBOrd NominalDiffTime
+instance DBOrd CalendarDiffTime
 instance DBOrd Text
 instance DBOrd Lazy.Text
 instance DBOrd (CI Text)
@@ -93,8 +92,7 @@ instance DBMax UTCTime
 instance DBMax Day
 instance DBMax LocalTime
 instance DBMax TimeOfDay
-instance DBMax DiffTime
-instance DBMax NominalDiffTime
+instance DBMax CalendarDiffTime
 instance DBMax Text
 instance DBMax Lazy.Text
 instance DBMax (CI Text)
@@ -124,8 +122,7 @@ instance DBMin UTCTime
 instance DBMin Day
 instance DBMin LocalTime
 instance DBMin TimeOfDay
-instance DBMin DiffTime
-instance DBMin NominalDiffTime
+instance DBMin CalendarDiffTime
 instance DBMin Text
 instance DBMin Lazy.Text
 instance DBMin (CI Text)

src/Rel8/Type/ReadShow.hs

@@ -14,17 +14,6 @@ import qualified Data.Text as Text
 
 -- | A deriving-via helper type for column types that store a Haskell value
 -- using a Haskell's 'Read' and 'Show' type classes.
---
--- The declaration:
--- 
--- >>> :{
--- data Color = Red | Green | Blue
---   deriving (Read, Show)
---   deriving PrimitiveType via ReadShow Color
--- :}
--- 
--- will allow you to store @Color@ values in a single SQL column (stored as
--- @text@).
 newtype ReadShow a = ReadShow { fromReadShow :: a }
 
 

src/Rel8/Type/Semigroup.hs

@@ -39,11 +39,11 @@ import Data.Text ( Text )
 import qualified Data.Text.Lazy as Lazy ( Text )
 
 -- time
-import Data.Time.Clock ( DiffTime, NominalDiffTime )
+import Data.Time.LocalTime ( CalendarDiffTime )
 
 
--- | The class of 'DBType's that form a semigroup. This class is purely a Rel8
--- concept, and exists to mirror the 'Semigroup' class.
+-- | The class of 'Rel8.DBType's that form a semigroup. This class is purely a
+-- Rel8 concept, and exists to mirror the 'Semigroup' class.
 type DBSemigroup :: Type -> Constraint
 class DBType a => DBSemigroup a where
   -- | An associative operation.
@@ -59,11 +59,7 @@ instance Sql DBType a => DBSemigroup (NonEmpty a) where
   (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
 
 
-instance DBSemigroup DiffTime where
-  (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
-
-
-instance DBSemigroup NominalDiffTime where
+instance DBSemigroup CalendarDiffTime where
   (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
 
 

src/Rel8/Type/Sum.hs

@@ -24,7 +24,7 @@ import Rel8.Type ( DBType )
 import Data.Scientific ( Scientific )
 
 -- time
-import Data.Time.Clock ( DiffTime, NominalDiffTime )
+import Data.Time.LocalTime ( CalendarDiffTime )
 
 
 -- | The class of database types that support the @sum()@ aggregation function.
@@ -36,8 +36,7 @@ instance DBSum Int64
 instance DBSum Float
 instance DBSum Double
 instance DBSum Scientific
-instance DBSum DiffTime
-instance DBSum NominalDiffTime
+instance DBSum CalendarDiffTime
 
 
 instance {-# INCOHERENT #-} (HasNullability a, DBSum (Unnullify a)) =>