From 8b782160900ddd6e942f38be45a5d710314b9ff1 Mon Sep 17 00:00:00 2001
From: Tom Ellis <tom-git@jaguarpaw.co.uk>
Date: Fri, 4 Oct 2024 12:23:53 +0100
Subject: [PATCH] Add omitOnWriteTableField

---
 src/Opaleye/Internal/Table.hs | 8 ++++++++
 src/Opaleye/Table.hs          | 1 +
 2 files changed, 9 insertions(+)

diff --git a/src/Opaleye/Internal/Table.hs b/src/Opaleye/Internal/Table.hs
index 7136ba61..1dded982 100644
--- a/src/Opaleye/Internal/Table.hs
+++ b/src/Opaleye/Internal/Table.hs
@@ -87,6 +87,9 @@ newtype Writer columns dummy =
   Writer (forall f. Functor f =>
           PM.PackMap (f HPQ.PrimExpr, String) () (f columns) ())
 
+coerceWriterOutput :: Writer columns dummy -> Writer columns dummy'
+coerceWriterOutput (Writer w) = Writer w
+
 -- | 'requiredTableField' is for fields which are not optional.  You
 -- must provide them on writes.
 requiredTableField :: String -> TableFields (Field_ n a) (Field_ n a)
@@ -109,6 +112,11 @@ optionalTableField columnName = TableFields
 readOnlyTableField :: String -> TableFields () (Field_ n a)
 readOnlyTableField = lmap (const Nothing) . optionalTableField
 
+omitOnWriteTableField :: String -> TableFields () (Field_ n a)
+omitOnWriteTableField columnName = TableFields
+  (coerceWriterOutput (pure ()))
+  (View (Column (HPQ.BaseTableAttrExpr columnName)))
+
 -- | You should not define your own instances of
 -- 'InferrableTableField'.
 class InferrableTableField w n r
diff --git a/src/Opaleye/Table.hs b/src/Opaleye/Table.hs
index dba880c5..10c33042 100644
--- a/src/Opaleye/Table.hs
+++ b/src/Opaleye/Table.hs
@@ -63,6 +63,7 @@ module Opaleye.Table (-- * Defining tables
                       T.tableField,
                       T.optionalTableField,
                       T.requiredTableField,
+                      T.omitOnWriteTableField,
                       T.InferrableTableField,
                       -- * Selecting from tables
                       selectTable,