diff --git a/changelog.md b/changelog.md index 50d7f74..5a38c39 100644 --- a/changelog.md +++ b/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 diff --git a/esqueleto.cabal b/esqueleto.cabal index b767528..6cc357a 100644 --- a/esqueleto.cabal +++ b/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. . diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs index f3d12d6..072d273 100644 --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/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 + ) diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index 13cae96..b6dd098 100644 --- a/test/PostgreSQL/Test.hs +++ b/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