From e84542a7dc5be66773db56ca2750f3fca60bbf6b Mon Sep 17 00:00:00 2001
From: Laurent Rene de Cotret <l.rdc@socivolta.com>
Date: Sat, 11 Jan 2025 21:37:46 -0500
Subject: [PATCH] Make the input of `values_` a non-empty list

---
 beam-core/Database/Beam/Query/Combinators.hs     | 16 ++++++++++++----
 .../test/Database/Beam/Postgres/Test/Select.hs   |  3 ++-
 .../test/Database/Beam/Sqlite/Test/Select.hs     |  4 +++-
 docs/beam-templates/chinook.hs                   |  1 +
 docs/user-guide/queries/select.md                |  2 +-
 5 files changed, 19 insertions(+), 7 deletions(-)

diff --git a/beam-core/Database/Beam/Query/Combinators.hs b/beam-core/Database/Beam/Query/Combinators.hs
index 8f6ce2a8a..d18fa9219 100644
--- a/beam-core/Database/Beam/Query/Combinators.hs
+++ b/beam-core/Database/Beam/Query/Combinators.hs
@@ -80,6 +80,8 @@ import Control.Monad.Identity
 import Control.Monad.Free
 import Control.Applicative
 
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe
 import Data.Proxy
 import Data.Time (LocalTime)
@@ -105,16 +107,22 @@ allFromView_ (DatabaseEntity vw) =
                     (tableFieldsToExpressions (dbViewSettings vw))
                     (\_ -> Nothing) snd)
 
--- | SQL @VALUES@ clause. Introduce the elements of the given list as
+-- | SQL @VALUES@ clause. Introduce the elements of the given non-empty list as
 -- rows in a joined table.
 values_ :: forall be db s a
          . ( Projectible be a
            , BeamSqlBackend be )
-        => [ a ] -> Q be db s a
+        => NonEmpty a
+        -> Q be db s a
 values_ rows =
-    Q $ liftF (QAll (\tblPfx -> fromTable (tableFromValues (map (\row -> project (Proxy @be) row tblPfx) rows)) . Just . (,Just fieldNames))
+    Q $ liftF (QAll (\tblPfx -> 
+                      fromTable 
+                        (tableFromValues (NonEmpty.toList (NonEmpty.map (\row -> project (Proxy @be) row tblPfx) rows))) 
+                        . Just 
+                        . (,Just fieldNames))
                     (\tblNm' -> fst $ mkFieldNames (qualifiedField tblNm'))
-                    (\_ -> Nothing) snd)
+                    (\_ -> Nothing) snd
+              )
     where
       fieldNames = snd $ mkFieldNames @be @a unqualifiedField
 
diff --git a/beam-postgres/test/Database/Beam/Postgres/Test/Select.hs b/beam-postgres/test/Database/Beam/Postgres/Test/Select.hs
index 797c3c632..94a050f6a 100644
--- a/beam-postgres/test/Database/Beam/Postgres/Test/Select.hs
+++ b/beam-postgres/test/Database/Beam/Postgres/Test/Select.hs
@@ -4,6 +4,7 @@ module Database.Beam.Postgres.Test.Select (tests) where
 
 import           Data.Aeson
 import           Data.ByteString (ByteString)
+import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Int
 import qualified Data.Vector as V
 import           Test.Tasty
@@ -82,7 +83,7 @@ testUuuidInValues getConn = testCase "UUID in values_ works" $
         pgCreateExtension @UuidOssp
       let ext = getPgExtension $ _uuidOssp $ unCheckDatabase db
       runSelectReturningList $ select $ do
-        v <- values_ [val_ nil]
+        v <- values_ (NonEmpty.singleton (val_ nil))
         return $ pgUuidGenerateV5 ext v ""
     assertEqual "result" [V5.generateNamed nil []] result
 
diff --git a/beam-sqlite/test/Database/Beam/Sqlite/Test/Select.hs b/beam-sqlite/test/Database/Beam/Sqlite/Test/Select.hs
index 511de1da3..9ad3263bb 100644
--- a/beam-sqlite/test/Database/Beam/Sqlite/Test/Select.hs
+++ b/beam-sqlite/test/Database/Beam/Sqlite/Test/Select.hs
@@ -6,6 +6,8 @@ import Data.Int (Int32)
 
 import Database.Beam
 import Database.Beam.Sqlite
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
 import Test.Tasty
 import Test.Tasty.ExpectedFailure
 import Test.Tasty.HUnit
@@ -51,5 +53,5 @@ testExceptValues :: TestTree
 testExceptValues = testCase "EXCEPT with VALUES works" $
   withTestDb $ \conn -> do
     result <- runBeamSqlite conn $ runSelectReturningList $ select $
-      values_ [as_ @Bool $ val_ True, val_ False] `except_` values_ [val_ False]
+      values_ ((as_ @Bool $ val_ True) :| [ val_ False]) `except_` values_ (NonEmpty.singleton (val_ False))
     assertEqual "result" [True] result
diff --git a/docs/beam-templates/chinook.hs b/docs/beam-templates/chinook.hs
index 3bb22ab0f..f30e98ac9 100644
--- a/docs/beam-templates/chinook.hs
+++ b/docs/beam-templates/chinook.hs
@@ -13,6 +13,7 @@ import Control.Monad
 import Control.Exception
 
 import Data.IORef
+import Data.List.NonEmpty (NonEmpty(..))
 import Data.Monoid ((<>))
 import Data.Int
 import Data.Text
diff --git a/docs/user-guide/queries/select.md b/docs/user-guide/queries/select.md
index 94975d41f..efeacc995 100644
--- a/docs/user-guide/queries/select.md
+++ b/docs/user-guide/queries/select.md
@@ -222,7 +222,7 @@ For example, to get all customers we know to be in New York, California, and Tex
 ```haskell
 !example chinook !on:Sqlite !on:MySQL
 do c <- all_ (customer chinookDb)
-   st <- values_ [ "NY", "CA", "TX" ]
+   st <- values_ ("NY" :| [ "CA", "TX" ]) -- (:|) is the constructor of NonEmpty
    guard_' (just_ st ==?. addressState (customerAddress c))
    pure c
 ```