Add upsert support and allow arbitrary queries in INSERT, UPDATE and …

…DELETE

This PR makes several changes to our "manipulation" functions (`insert`, `update`, `delete`).

Firstly, we now support `ON CONFLICT DO UPDATE`, aka "upsert".

Secondly, we now allow the insertion of arbitrary queries (not just static `VALUES`). `values` recovers the old behaviour.

Thirdly, our `Update` and `Delete` statements now support `FROM` and `USING` clauses respectively, allowing joining against other tables.

Fourthly, `Returning` is now an `Applicative`, which means you can say `returning = pure ()` if you don't care about the number of rows affected.

In terms of generating the SQL to implement these features, it was unfortunately significantly less work to roll our own here than to add this upstream to Opaleye proper, because it would have required more refactoring than I felt comfortable doing.

docs/concepts/insert.rst

@@ -21,9 +21,15 @@ using ``delete``. ``Delete`` takes:
 ``from``
   The ``TableSchema`` for the table to delete rows from.
 
+``using``
+  This is a simple ``Query`` that forms the ``USING`` clause of the ``UPDATE``
+  statement. This can be used to join against other tables, and the results
+  can be referenced in the ``deleteWhere`` parameters.
+
 ``deleteWhere``
   The ``WHERE`` clause of the ``DELETE`` statement. This is a function that
-  takes a single ``Expr`` table as input.
+  takes two inputs: the result of the ``using`` query, and the current value
+  of the row.
 
 ``returning``
   What to return - see :ref:`returning`.
@@ -37,16 +43,22 @@ using ``update``. ``Update`` takes:
 ``target``
   The ``TableSchema`` for the table to update rows in.
 
-``updateWhere``
-  The ``WHERE`` clause of the ``UPDATE`` statement. This is a function that
-  takes a single ``Expr`` table as input.
+``from``
+  This is a simple ``Query`` that forms the ``FROM`` clause of the ``UPDATE``
+  statement. This can be used to join against other tables, and the results
+  can be referenced in the ``set`` and ``updateWhere`` parameters.
 
 ``set``
   A row to row transformation function, indicating how to update selected rows.
   This function takes rows of the same shape as ``target`` but in the ``Expr``
   context. One way to write this function is to use record update syntax::
 
-    set = \row -> row { rowName = "new name" }
+    set = \from row -> row { rowName = "new name" }
+
+``updateWhere``
+  The ``WHERE`` clause of the ``UPDATE`` statement. This is a function that
+  takes two inputs: the result of the ``from`` query, and the current value of
+  the row.
 
 ``returning``
   What to return - see :ref:`returning`.
@@ -64,11 +76,11 @@ using ``insert``. ``Insert`` takes:
   The rows to insert. These are the same as ``into``, but in the ``Expr``
   context. You can construct rows from their individual fields::
 
-    rows = [ MyTable { myTableA = lit "A", myTableB = lit 42 }
+    rows = values [ MyTable { myTableA = lit "A", myTableB = lit 42 }
 
   or you can use ``lit`` on a table value in the ``Result`` context::
 
-    rows = [ lit MyTable { myTableA = "A", myTableB = 42 }
+    rows = values [ lit MyTable { myTableA = "A", myTableB = 42 }
 
 ``onConflict``
   What should happen if an insert clashes with rows that already exist. This
@@ -80,6 +92,10 @@ using ``insert``. ``Insert`` takes:
   ``DoNothing``
     PostgreSQL should not insert the duplicate rows.
 
+  ``DoUpdate``
+    PostgreSQL should instead try to update any existing rows that conflict
+    with rows proposed for insertion.
+
 ``returning``
   What to return - see :ref:`returning`.
 
@@ -99,11 +115,20 @@ For example, if we are inserting orders, we might want the order ids returned::
 
   insert Insert
     { into = orderSchema
-    , rows = [ order ]
+    , rows = values [ order ]
     , onConflict = Abort
     , returning = Projection orderId
     }
 
+If we don't want to return anything, we can use ``pure ()``::
+
+  insert Insert
+    { into = orderSchema
+    , rows = values [ order ]
+    , onConflict = Abort
+    , returning = pure ()
+    }
+
 Default values
 --------------
 
@@ -119,7 +144,7 @@ construct the ``DEFAULT`` expression::
 
   insert Insert
     { into = orderSchema
-    , rows = [ Order { orderId = unsafeDefault, ... } ]
+    , rows = values [ Order { orderId = unsafeDefault, ... } ]
     , onConflict = Abort
     , returning = Projection orderId
     }
@@ -148,7 +173,7 @@ them in Rel8, rather than in your database schema.
 
      insert Insert
        { into = orderSchema
-       , rows = [ Order { orderId = nextval "order_id_seq", ... } ]
+       , rows = values [ Order { orderId = nextval "order_id_seq", ... } ]
        , onConflict = Abort
        , returning = Projection orderId
        }

rel8.cabal

@@ -27,6 +27,7 @@ library
     , contravariant
     , hasql ^>= 1.4.5.1
     , opaleye ^>= 0.7.3.0
+    , pretty
     , profunctors
     , scientific
     , semialign
@@ -138,10 +139,15 @@ library
 
     Rel8.Statement.Delete
     Rel8.Statement.Insert
+    Rel8.Statement.OnConflict
     Rel8.Statement.Returning
     Rel8.Statement.Select
+    Rel8.Statement.Set
+    Rel8.Statement.SQL
     Rel8.Statement.Update
+    Rel8.Statement.Using
     Rel8.Statement.View
+    Rel8.Statement.Where
 
     Rel8.Table
     Rel8.Table.ADT

src/Rel8.hs

@@ -258,19 +258,25 @@ module Rel8
     -- ** @INSERT@
   , Insert(..)
   , OnConflict(..)
+  , Upsert(..)
   , insert
   , unsafeDefault
+  , showInsert
 
     -- ** @DELETE@
   , Delete(..)
   , delete
+  , showDelete
 
     -- ** @UPDATE@
   , Update(..)
+  , Set
+  , Where
   , update
+  , showUpdate
 
     -- ** @.. RETURNING@
-  , Returning(..)
+  , Returning( NumberOfRowsAffected, Projection )
 
     -- ** @CREATE VIEW@
   , createView
@@ -332,10 +338,14 @@ import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Table
 import Rel8.Statement.Delete
 import Rel8.Statement.Insert
+import Rel8.Statement.OnConflict
 import Rel8.Statement.Returning
 import Rel8.Statement.Select
+import Rel8.Statement.Set
+import Rel8.Statement.SQL
 import Rel8.Statement.Update
 import Rel8.Statement.View
+import Rel8.Statement.Where
 import Rel8.Table
 import Rel8.Table.ADT
 import Rel8.Table.Aggregate

src/Rel8/Query/SQL.hs

@@ -1,75 +1,21 @@
 {-# language FlexibleContexts #-}
-{-# language TypeFamilies #-}
-{-# language ViewPatterns #-}
+{-# language MonoLocalBinds #-}
 
 module Rel8.Query.SQL
   ( showQuery
-  , sqlForQuery, sqlForQueryWithNames
   )
 where
 
 -- base
-import Data.Foldable ( fold )
-import Data.Functor.Const ( Const( Const ), getConst )
-import Data.Void ( Void )
 import Prelude
 
--- opaleye
-import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
-import qualified Opaleye.Internal.PrimQuery as Opaleye
-import qualified Opaleye.Internal.Print as Opaleye
-import qualified Opaleye.Internal.Optimize as Opaleye
-import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
-import qualified Opaleye.Internal.Sql as Opaleye
-
 -- rel8
 import Rel8.Expr ( Expr )
-import Rel8.Expr.Opaleye ( toPrimExpr )
 import Rel8.Query ( Query )
-import Rel8.Query.Opaleye ( toOpaleye )
-import Rel8.Schema.Name ( Name( Name ), Selects )
-import Rel8.Schema.HTable ( htabulateA, hfield )
-import Rel8.Table ( Table, toColumns )
-import Rel8.Table.Cols ( toCols )
-import Rel8.Table.Name ( namesFromLabels )
-import Rel8.Table.Opaleye ( castTable )
+import Rel8.Statement.Select ( ppSelect )
+import Rel8.Table ( Table )
 
 
--- | Convert a query to a 'String' containing the query as a @SELECT@
--- statement.
+-- | Convert a 'Query' to a 'String' containing a @SELECT@ statement.
 showQuery :: Table Expr a => Query a -> String
-showQuery = fold . sqlForQuery
-
-
-sqlForQuery :: Table Expr a
-  => Query a -> Maybe String
-sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toCols
-
-
-sqlForQueryWithNames :: Selects names exprs
-  => names -> Query exprs -> Maybe String
-sqlForQueryWithNames names query =
-  show . Opaleye.ppSql . selectFrom names exprs <$> optimize primQuery
-  where
-    (exprs, primQuery, _) =
-      Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
-
-
-optimize :: Opaleye.PrimQuery' a -> Maybe (Opaleye.PrimQuery' Void)
-optimize = Opaleye.removeEmpty . Opaleye.optimize
-
-
-selectFrom :: Selects names exprs
-  => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
-selectFrom (toColumns -> names) (toColumns . castTable -> exprs) query =
-  Opaleye.SelectFrom $ Opaleye.newSelect
-    { Opaleye.attrs = Opaleye.SelectAttrs attributes
-    , Opaleye.tables = Opaleye.oneTable select
-    }
-  where
-    select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query
-    attributes = getConst $ htabulateA $ \field -> case hfield names field of
-      Name name -> case hfield exprs field of
-        expr -> Const (pure (makeAttr name (toPrimExpr expr)))
-    makeAttr label expr =
-      (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))
+showQuery = foldMap show . ppSelect

src/Rel8/Schema/Name.hs

@@ -13,6 +13,7 @@
 module Rel8.Schema.Name
   ( Name(..)
   , Selects
+  , ppColumn
   )
 where
 
@@ -22,6 +23,13 @@ import Data.Kind ( Constraint, Type )
 import Data.String ( IsString )
 import Prelude
 
+-- opaleye
+import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
+import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
+
+-- pretty
+import Text.PrettyPrint ( Doc )
+
 -- rel8
 import Rel8.Expr ( Expr )
 import qualified Rel8.Schema.Kind as K
@@ -63,3 +71,7 @@ instance Sql DBType a => Table Name (Name a) where
 type Selects :: Type -> Type -> Constraint
 class Transposes Name Expr names exprs => Selects names exprs
 instance Transposes Name Expr names exprs => Selects names exprs
+
+
+ppColumn :: String -> Doc
+ppColumn = Opaleye.ppSqlExpr . Opaleye.ColumnSqlExpr . Opaleye.SqlColumn

src/Rel8/Schema/Table.hs

@@ -1,14 +1,24 @@
 {-# language DeriveFunctor #-}
 {-# language DerivingStrategies #-}
+{-# language DisambiguateRecordFields #-}
+{-# language NamedFieldPuns #-}
 
 module Rel8.Schema.Table
   ( TableSchema(..)
+  , ppTable
   )
 where
 
 -- base
 import Prelude
 
+-- opaleye
+import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
+import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
+
+-- pretty
+import Text.PrettyPrint ( Doc )
+
 
 -- | The schema for a table. This is used to specify the name and schema that a
 -- table belongs to (the @FROM@ part of a SQL query), along with the schema of
@@ -27,3 +37,10 @@ data TableSchema names = TableSchema
     -- data type here, parameterized by the 'Rel8.ColumnSchema.ColumnSchema' functor.
   }
   deriving stock Functor
+
+
+ppTable :: TableSchema a -> Doc
+ppTable TableSchema {name, schema} = Opaleye.ppTable Opaleye.SqlTable
+  { sqlTableSchemaName = schema
+  , sqlTableName = name
+  }