Add support of PostgreSQL-specific VALUES(..) expression (#284)

* Add PostgreSQL-specific support of VALUES(..)
scalar expression of values-list for `from` targets.

* Bump version and update changelog

* Align identation for Postgres `values` func

* Use direct `From` data-type instead
of `ToFrom` typeclass for postgres `values` expression.

changelog.md

@@ -1,3 +1,9 @@
+3.5.2.3
+=======
+- @NikitaRazmakhnin
+  - [#284](https://github.com/bitemyapp/esqueleto/pull/284)
+        - Add PostgreSQL-specific support of VALUES(..) literals
+
 3.5.2.2
 =======
 - @NikitaRazmakhnin

esqueleto.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           esqueleto
-version:        3.5.2.2
+version:        3.5.2.3
 synopsis:       Type-safe EDSL for SQL queries on persistent backends.
 description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.
                 .

src/Database/Esqueleto/PostgreSQL.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -26,6 +28,7 @@ module Database.Esqueleto.PostgreSQL
     , insertSelectWithConflict
     , insertSelectWithConflictCount
     , filterWhere
+    , values
     -- * Internal
     , unsafeSqlAggregateFunction
     ) where
@@ -39,9 +42,14 @@ import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(..))
 import qualified Control.Monad.Trans.Reader as R
 import Data.Int (Int64)
+import qualified Data.List.NonEmpty as NE
+import Data.Maybe
 import Data.Proxy (Proxy(..))
 import qualified Data.Text.Internal.Builder as TLB
+import qualified Data.Text.Lazy as TL
 import Data.Time.Clock (UTCTime)
+import qualified Database.Esqueleto.Experimental as Ex
+import qualified Database.Esqueleto.Experimental.From as Ex
 import Database.Esqueleto.Internal.Internal hiding (random_)
 import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
 import Database.Persist.Class (OnlyOneUniqueKey)
@@ -363,3 +371,68 @@ filterWhere aggExpr clauseExpr = ERaw noMeta $ \_ info ->
     in ( aggBuilder <> " FILTER (WHERE " <> clauseBuilder <> ")"
        , aggValues <> clauseValues
        )
+
+
+-- | Allows to use `VALUES (..)` in-memory set of values
+-- in RHS of `from` expressions. Useful for JOIN's on
+-- known values which also can be additionally preprocessed
+-- somehow on db side with usage of inner PostgreSQL capabilities.
+--
+--
+-- Example of usage:
+--
+-- @
+-- share [mkPersist sqlSettings] [persistLowerCase|
+--   User
+--     name Text
+--     age Int
+--     deriving Eq Show
+--
+-- select $ do
+--  bound :& user <- from $
+--      values (   (val (10 :: Int), val ("ten" :: Text))
+--            :| [ (val 20, val "twenty")
+--               , (val 30, val "thirty") ]
+--            )
+--      `InnerJoin` table User
+--      `on` (\((bound, _boundName) :& user) -> user^.UserAge >=. bound)
+--  groupBy bound
+--  pure (bound, count @Int $ user^.UserName)
+-- @
+--
+-- @since 3.5.2.3
+values :: (ToSomeValues a, Ex.ToAliasReference a, Ex.ToAlias a) => NE.NonEmpty a -> Ex.From a
+values exprs = Ex.From $ do
+    ident <- newIdentFor $ DBName "vq"
+    alias <- Ex.toAlias $ NE.head exprs
+    ref   <- Ex.toAliasReference ident alias
+    let aliasIdents = mapMaybe (\someVal -> case someVal of
+            SomeValue (ERaw aliasMeta _) -> sqlExprMetaAlias aliasMeta
+            ) $ toSomeValues ref
+    pure (ref, const $ mkExpr ident aliasIdents)
+  where
+    someValueToSql :: IdentInfo -> SomeValue -> (TLB.Builder, [PersistValue])
+    someValueToSql info (SomeValue expr) = materializeExpr info expr
+
+    mkValuesRowSql :: IdentInfo -> [SomeValue] -> (TLB.Builder, [PersistValue])
+    mkValuesRowSql info vs =
+        let materialized = someValueToSql info <$> vs
+            valsSql = TLB.toLazyText . fst <$> materialized
+            params = concatMap snd materialized
+        in (TLB.fromLazyText $ "(" <> TL.intercalate "," valsSql <> ")", params)
+
+    -- (VALUES (v11, v12,..), (v21, v22,..)) as "vq"("v1", "v2",..)
+    mkExpr :: Ident -> [Ident] -> IdentInfo -> (TLB.Builder, [PersistValue])
+    mkExpr valsIdent colIdents info =
+        let materialized = mkValuesRowSql info . toSomeValues <$> NE.toList exprs
+            (valsSql, params) =
+                ( TL.intercalate "," $ map (TLB.toLazyText . fst) materialized
+                , concatMap snd materialized
+                )
+            colsAliases = TL.intercalate "," (map (TLB.toLazyText . useIdent info) colIdents)
+        in
+            ( "(VALUES " <> TLB.fromLazyText valsSql <> ") AS "
+            <> useIdent info valsIdent
+            <> "(" <> TLB.fromLazyText colsAliases <> ")"
+            , params
+            )

test/PostgreSQL/Test.hs

@@ -25,6 +25,7 @@ import qualified Data.Char as Char
 import Data.Coerce
 import Data.Foldable
 import qualified Data.List as L
+import qualified Data.List.NonEmpty as NE
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
 import Data.Ord (comparing)
@@ -1270,6 +1271,53 @@ testLateralQuery = do
             let _ = res :: [(Entity Lord, Value (Maybe Int))]
             asserting noExceptions
 
+testValuesExpression :: SpecDb
+testValuesExpression = do
+    describe "(VALUES (..)) query" $ do
+        itDb "works with joins and other sql expressions" $ do
+            p1k <- insert p1
+            p2k <- insert p2
+            p3k <- insert p3
+            let exprs :: NE.NonEmpty (SqlExpr (Value Int), SqlExpr (Value Text))
+                exprs =   (val 10, val "ten")
+                    NE.:| [ (val 20, val "twenty")
+                        , (val 30, val "thirty") ]
+                query = do
+                    (bound, boundName) :& person <- Experimental.from $
+                        EP.values exprs
+                        `Experimental.InnerJoin` table @Person
+                        `Experimental.on` (\((bound, boundName) :& person) -> person^.PersonAge >=. just bound)
+                    groupBy bound
+                    orderBy [ asc bound ]
+                    pure (bound, count @Int $ person^.PersonName)
+            result <- select query
+            liftIO $ result `shouldBe` [ (Value 10, Value 2)
+                                       , (Value 20, Value 1)
+                                       , (Value 30, Value 1) ]
+
+        itDb "supports single-column query" $ do
+            let query = do
+                    vInt <- Experimental.from $ EP.values $ val 1 NE.:| [ val 2, val 3 ]
+                    pure (vInt :: SqlExpr (Value Int))
+            result <- select query
+            asserting noExceptions
+            liftIO $ result `shouldBe` [ Value 1, Value 2, Value 3 ]
+
+        itDb "supports multi-column query (+ nested simple expression and null)" $ do
+            let query = do
+                    (vInt, vStr, vDouble) <- Experimental.from
+                        $ EP.values $ (val 1, val "str1", coalesce [just $ val 1.0, nothing])
+                                NE.:| [ (val 2, val "str2", just $ val 2.5)
+                                      , (val 3, val "str3", nothing) ]
+                    pure ( vInt :: SqlExpr (Value Int)
+                            , vStr :: SqlExpr (Value Text)
+                            , vDouble :: SqlExpr (Value (Maybe Double)) )
+            result <- select query
+            asserting noExceptions
+            liftIO $ result `shouldBe` [ (Value 1, Value "str1", Value $ Just 1.0)
+                                       , (Value 2, Value "str2", Value $ Just 2.5)
+                                       , (Value 3, Value "str3", Value Nothing) ]
+
 type JSONValue = Maybe (JSONB A.Value)
 
 createSaneSQL :: (PersistField a, MonadIO m) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> SqlPersistT m ()
@@ -1362,6 +1410,7 @@ spec = beforeAll mkConnectionPool $ do
                 testJSONInsertions
                 testJSONOperators
         testLateralQuery
+        testValuesExpression
 
 insertJsonValues :: SqlPersistT IO ()
 insertJsonValues = do