From 56402f0ca370649fdf0af27476d5fb4ef861a7c6 Mon Sep 17 00:00:00 2001
From: Teo Camarasu <teofilcamarasu@gmail.com>
Date: Mon, 21 Sep 2026 15:12:36 +0100
Subject: [PATCH] Introduce a DBSequence typeclass for sequence DB types

We add a new DBSequence typeclass to track database types that can be
used in sequences. This is basically all sizes of
integers (Int16,Int32,Int64). They are the types that `nextval` can generate.

Previously we forced this to be only Int64.

It's up to the user to ensure that the correct type is being used with
the correct postgres sequence.
---
 .../20260921_150002_teofilcamarasu_dbseq.md   |  6 +++++
 .../src/Rel8/Internal/Expr/Sequence.hs        | 15 ++++++++++---
 rel8/src/Rel8.hs                              |  1 +
 rel8/tests/Main.hs                            | 22 ++++++++++++++++++-
 4 files changed, 40 insertions(+), 4 deletions(-)
 create mode 100644 changelog.d/20260921_150002_teofilcamarasu_dbseq.md

diff --git a/changelog.d/20260921_150002_teofilcamarasu_dbseq.md b/changelog.d/20260921_150002_teofilcamarasu_dbseq.md
new file mode 100644
index 00000000..cd45fbeb
--- /dev/null
+++ b/changelog.d/20260921_150002_teofilcamarasu_dbseq.md
@@ -0,0 +1,6 @@
+### Added
+
+- Added a `DBSequence` typeclass that tracks database types that can be used with `nextval`
+
+### Changed
+- `nextval` has become polymorphic and it can now generate any `DBSequence` rather than just an `Int64`
diff --git a/rel8-internal/src/Rel8/Internal/Expr/Sequence.hs b/rel8-internal/src/Rel8/Internal/Expr/Sequence.hs
index 562b7957..620ea3db 100644
--- a/rel8-internal/src/Rel8/Internal/Expr/Sequence.hs
+++ b/rel8-internal/src/Rel8/Internal/Expr/Sequence.hs
@@ -1,10 +1,11 @@
 module Rel8.Internal.Expr.Sequence
-  ( nextval
+  ( DBSequence
+  , nextval
   )
 where
 
 -- base
-import Data.Int ( Int64 )
+import Data.Int ( Int16, Int32, Int64 )
 import Prelude
 
 -- opaleye
@@ -15,9 +16,17 @@ import Rel8.Internal.Expr ( Expr )
 import Rel8.Internal.Expr.Opaleye (fromPrimExpr)
 import Rel8.Internal.Schema.QualifiedName (QualifiedName, showQualifiedName)
 
+-- | The class of database types that can be sequences and support 'nextval'.
+-- 'Int64' is recommended.
+-- See: https://www.postgresql.org/docs/current/sql-createsequence.html
+class DBSequence a
+instance DBSequence Int16
+instance DBSequence Int32
+instance DBSequence Int64
+
 
 -- | See https://www.postgresql.org/docs/current/functions-sequence.html
-nextval :: QualifiedName -> Expr Int64
+nextval :: DBSequence a => QualifiedName -> Expr a
 nextval name =
   fromPrimExpr $
     Opaleye.FunExpr "nextval"
diff --git a/rel8/src/Rel8.hs b/rel8/src/Rel8.hs
index cf83d20e..6ab1c289 100644
--- a/rel8/src/Rel8.hs
+++ b/rel8/src/Rel8.hs
@@ -390,6 +390,7 @@ module Rel8
   , createOrReplaceView
 
     -- ** Sequences
+  , DBSequence
   , nextval
   , evaluate
   ) where
diff --git a/rel8/tests/Main.hs b/rel8/tests/Main.hs
index 463ae070..d82b1384 100644
--- a/rel8/tests/Main.hs
+++ b/rel8/tests/Main.hs
@@ -34,7 +34,7 @@ import Data.Fixed (Fixed (MkFixed))
 import Data.Foldable ( for_ )
 import Data.Fixed (Centi)
 import Data.Functor (void)
-import Data.Int ( Int32, Int64 )
+import Data.Int ( Int16, Int32, Int64 )
 import Data.List ( isInfixOf, nub, sort )
 import Data.Maybe ( catMaybes )
 import Data.Ratio ((%))
@@ -162,6 +162,7 @@ tests =
     , testEvaluate getTestDatabase
     , testSelectTruncated getTestDatabase
     , testShowCreateTable getTestDatabase
+    , testNextVal getTestDatabase
     ]
   where
     startTestDatabase = do
@@ -173,6 +174,8 @@ tests =
           sql "CREATE TABLE test_table ( column1 text not null, column2 bool not null )"
           sql "CREATE TABLE unique_table ( \"key\" text not null unique, \"value\" text not null )"
           sql "CREATE SEQUENCE test_seq"
+          sql "CREATE SEQUENCE test_seq_small AS smallint"
+          sql "CREATE SEQUENCE test_seq_integer AS integer"
           sql "CREATE TYPE composite AS (\"bool\" bool, \"char\" text, \"array\" int4[])"
 
       return db
@@ -1400,3 +1403,20 @@ testSelectTruncated = databasePropertyTest "select truncates long column aliases
     sort (map (((,) <$> aFieldNameDefinitelyLongerThanThirtyCharsA <*>  aFieldNameDefinitelyLongerThanThirtyCharsB)
       . aFieldNameDefinitelyLongerThanThirtyCharsNestedWith) selected)
       === sort rows
+
+testNextVal :: IO TmpPostgres.DB -> TestTree
+testNextVal = databasePropertyTest "next_val works with all integer types" \transaction -> do
+
+  transaction do
+    (r1:: [Int64]) <- getNextVal "test_seq"
+    length r1 === 1
+      
+    (r2 :: [Int32]) <- getNextVal "test_seq_integer"
+    length r2 === 1
+      
+    (r3 :: [Int16]) <- getNextVal "test_seq_small"
+    length r3 === 1
+
+    pure ()
+  where
+    getNextVal seq = lift $ statement () $ Rel8.run $ Rel8.select $ pure $ Rel8.nextval seq