diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,15 @@ +3.3.3.3 +======= +- @belevy + - [#191](https://github.com/bitemyapp/esqueleto/pull/191) - Bugfix rollup: + Fix issue with extra characters in generated SQL; + Fix ToAliasReference for already referenced values; + Fix Alias/Reference for Maybe Entity +- @maxgabriel + - [#203](https://github.com/bitemyapp/esqueleto/pull/203) Document `isNothing` +- @sestrella + - [#198](https://github.com/bitemyapp/esqueleto/pull/198) - Allow PostgreSQL aggregate functions to take a filter clause + 3.3.3.2 ======== - @maxgabriel diff --git a/esqueleto.cabal b/esqueleto.cabal --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: esqueleto -version: 3.3.3.2 +version: 3.3.3.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/Experimental.hs b/src/Database/Esqueleto/Experimental.hs --- a/src/Database/Esqueleto/Experimental.hs +++ b/src/Database/Esqueleto/Experimental.hs @@ -9,6 +9,7 @@ , TypeFamilies , UndecidableInstances , OverloadedStrings + , PatternSynonyms #-} module Database.Esqueleto.Experimental @@ -23,7 +24,8 @@ -- * Documentation - SqlSetOperation(..) + SqlSetOperation(Union, UnionAll, Except, Intersect) + , pattern SelectQuery , From(..) , on , from @@ -68,6 +70,8 @@ , to3, to4, to5, to6, to7, to8 , from3, from4, from5, from6, from7, from8 , veryUnsafeCoerceSqlExprValue + , parensM + , NeedParens(..) ) import GHC.TypeLits @@ -379,8 +383,11 @@ | UnionAll (SqlSetOperation a) (SqlSetOperation a) | Except (SqlSetOperation a) (SqlSetOperation a) | Intersect (SqlSetOperation a) (SqlSetOperation a) - | SelectQuery (SqlQuery a) + | SelectQueryP NeedParens (SqlQuery a) +pattern SelectQuery :: SqlQuery a -> SqlSetOperation a +pattern SelectQuery q = SelectQueryP Never q + -- | Data type that represents the syntax of a 'JOIN' tree. In practice, -- only the @Table@ constructor is used directly when writing queries. For example, -- @@ -462,7 +469,7 @@ instance (SqlSelect a' r,SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'') => ToFrom (SqlSetOperation a) where -- If someone uses just a plain SelectQuery it should behave like a normal subquery - toFrom (SelectQuery q) = SubQuery q + toFrom (SelectQueryP _ q) = SubQuery q -- Otherwise use the SqlSetOperation toFrom q = SqlSetOperation q @@ -617,12 +624,21 @@ where aliasQueries o = case o of - SelectQuery q -> do + SelectQueryP p q -> do (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ q prevState <- Q $ lift S.get aliasedRet <- toAlias ret Q $ lift $ S.put prevState - pure (SelectQuery $ Q $ W.WriterT $ pure (aliasedRet, sideData), aliasedRet) + let p' = + case p of + Parens -> Parens + Never -> + if (sdLimitClause sideData) /= mempty + || length (sdOrderByClause sideData) > 0 then + Parens + else + Never + pure (SelectQueryP p' $ Q $ W.WriterT $ pure (aliasedRet, sideData), aliasedRet) Union o1 o2 -> do (o1', ret) <- aliasQueries o1 (o2', _ ) <- aliasQueries o2 @@ -642,7 +658,9 @@ operationToSql o info = case o of - SelectQuery q -> toRawSql SELECT info q + SelectQueryP p q -> + let (builder, values) = toRawSql SELECT info q + in (parensM p builder, values) Union o1 o2 -> doSetOperation "UNION" info o1 o2 UnionAll o1 o2 -> doSetOperation "UNION ALL" info o1 o2 Except o1 o2 -> doSetOperation "EXCEPT" info o1 o2 @@ -684,6 +702,7 @@ type family ToAliasT a where ToAliasT (SqlExpr (Value a)) = SqlExpr (Value a) ToAliasT (SqlExpr (Entity a)) = SqlExpr (Entity a) + ToAliasT (SqlExpr (Maybe (Entity a))) = SqlExpr (Maybe (Entity a)) ToAliasT (a, b) = (ToAliasT a, ToAliasT b) ToAliasT (a, b, c) = (ToAliasT a, ToAliasT b, ToAliasT c) ToAliasT (a, b, c, d) = (ToAliasT a, ToAliasT b, ToAliasT c, ToAliasT d) @@ -709,6 +728,9 @@ ident <- newIdentFor (DBName "v") pure $ EAliasedEntity ident tableIdent +instance ToAlias (SqlExpr (Maybe (Entity a))) where + toAlias (EMaybe e) = EMaybe <$> toAlias e + instance (ToAlias a, ToAlias b) => ToAlias (a,b) where toAlias (a,b) = (,) <$> toAlias a <*> toAlias b @@ -767,6 +789,7 @@ type family ToAliasReferenceT a where ToAliasReferenceT (SqlExpr (Value a)) = SqlExpr (Value a) ToAliasReferenceT (SqlExpr (Entity a)) = SqlExpr (Entity a) + ToAliasReferenceT (SqlExpr (Maybe (Entity a))) = SqlExpr (Maybe (Entity a)) ToAliasReferenceT (a,b) = (ToAliasReferenceT a, ToAliasReferenceT b) ToAliasReferenceT (a,b,c) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c) ToAliasReferenceT (a, b, c, d) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c, ToAliasReferenceT d) @@ -783,13 +806,15 @@ toAliasReference aliasSource (EAliasedValue aliasIdent _) = pure $ EValueReference aliasSource (\_ -> aliasIdent) toAliasReference _ v@(ERaw _ _) = toAlias v toAliasReference _ v@(ECompositeKey _) = toAlias v - toAliasReference _ v@(EValueReference _ _) = pure v + toAliasReference s (EValueReference _ b) = pure $ EValueReference s b instance ToAliasReference (SqlExpr (Entity a)) where toAliasReference aliasSource (EAliasedEntity ident _) = pure $ EAliasedEntityReference aliasSource ident toAliasReference _ e@(EEntity _) = toAlias e - toAliasReference _ e@(EAliasedEntityReference _ _) = pure e + toAliasReference s (EAliasedEntityReference _ b) = pure $ EAliasedEntityReference s b +instance ToAliasReference (SqlExpr (Maybe (Entity a))) where + toAliasReference s (EMaybe e) = EMaybe <$> toAliasReference s e instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a, b) where toAliasReference ident (a,b) = (,) <$> (toAliasReference ident a) <*> (toAliasReference ident b) diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -522,18 +522,18 @@ -> EntityField val typ -> SqlExpr (Value typ) (EAliasedEntityReference source base) ^. field = - EValueReference source (aliasedEntityColumnIdent base fieldDef) + EValueReference source (\_ -> aliasedEntityColumnIdent base fieldDef) where - fieldDef = - if isIdField field then + fieldDef = + if isIdField field then -- TODO what about composite natural keys in a join this will ignore them - head $ entityKeyFields ed + head $ entityKeyFields ed else persistFieldDef field ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) - -e ^. field + +e ^. field | isIdField field = idFieldValue | otherwise = ERaw Never $ \info -> (dot info $ persistFieldDef field, []) where @@ -548,17 +548,17 @@ ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) - dot info fieldDef = + dot info fieldDef = useIdent info sourceIdent <> "." <> fieldIdent where sourceIdent = - case e of + case e of EEntity ident -> ident EAliasedEntity baseI _ -> baseI - fieldIdent = - case e of - EEntity _ -> fromDBName info (fieldDB fieldDef) - EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef info + fieldIdent = + case e of + EEntity _ -> fromDBName info (fieldDB fieldDef) + EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef -- | Project an SqlExpression that may be null, guarding against null cases. withNonNull :: PersistField typ @@ -579,14 +579,30 @@ val v = ERaw Never $ const ("?", [toPersistValue v]) -- | @IS NULL@ comparison. +-- +-- For @IS NOT NULL@, you can negate this with 'not_', as in @not_ (isNothing (person ^. PersonAge))@ +-- +-- Warning: Persistent and Esqueleto have different behavior for @!= Nothing@: +-- +-- +----------------+----------------------------------+---------------+ +-- | | Haskell | SQL | +-- +================+==================================+===============+ +-- | __Persistent__ | @'Database.Persist.!=.' Nothing@ | @IS NOT NULL@ | +-- +----------------+----------------------------------+---------------+ +-- | __Esqueleto__ | @'!=.' Nothing@ | @!= NULL@ | +-- +----------------+----------------------------------+---------------+ +-- +-- In SQL, @= NULL@ and @!= NULL@ return NULL instead of true or false. For this reason, you very likely do not want to use @'!=.' Nothing@ in Esqueleto. + + isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool) -isNothing v = - case v of +isNothing v = + case v of ERaw p f -> isNullExpr $ first (parensM p) . f EAliasedValue i _ -> isNullExpr $ aliasedValueIdentToRawSql i EValueReference i i' -> isNullExpr $ valueReferenceToRawSql i i' ECompositeKey f -> ERaw Parens $ flip (,) [] . (intersperseB " AND " . map (<> " IS NULL")) . f - where + where isNullExpr :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value Bool) isNullExpr g = ERaw Parens $ first ((<> " IS NULL")) . g @@ -612,14 +628,14 @@ joinV (EValueReference i i') = EValueReference i i' -countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a) -countHelper open close v = +countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a) +countHelper open close v = case v of - ERaw _ f -> countRawSql f + ERaw _ f -> countRawSql f EAliasedValue i _ -> countRawSql $ aliasedValueIdentToRawSql i EValueReference i i' -> countRawSql $ valueReferenceToRawSql i i' - ECompositeKey _ -> countRows - where + ECompositeKey _ -> countRows + where countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) countRawSql x = ERaw Never $ first (\b -> "COUNT" <> open <> parens b <> close) . x @@ -941,7 +957,7 @@ let (fb, fv) = f x (gb, gv) = g x in (fb <> ", " <> gb, fv ++ gv) - where + where g = case v of ERaw _ f' -> f' @@ -1586,6 +1602,8 @@ | MakeSetError | MakeWhereError | MakeHavingError + | FilterWhereAggError + | FilterWhereClauseError deriving (Show) type CompositeKeyError = UnexpectedValueError @@ -1868,6 +1886,7 @@ -- | A @LIMIT@ clause. data LimitClause = Limit (Maybe Int64) (Maybe Int64) + deriving Eq instance Semigroup LimitClause where Limit l1 o1 <> Limit l2 o2 = @@ -1936,7 +1955,7 @@ EEntity :: Ident -> SqlExpr (Entity val) -- Base Table EAliasedEntity :: Ident -> Ident -> SqlExpr (Entity val) - -- Source Base + -- Source Base EAliasedEntityReference :: Ident -> Ident -> SqlExpr (Entity val) -- Just a tag stating that something is nullable. @@ -1950,7 +1969,7 @@ ERaw :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) - -- A raw expression with an alias + -- A raw expression with an alias EAliasedValue :: Ident -> SqlExpr (Value a) -> SqlExpr (Value a) -- A reference to an aliased field in a table or subquery @@ -2024,6 +2043,7 @@ data InsertFinal data NeedParens = Parens | Never + deriving Eq parensM :: NeedParens -> TLB.Builder -> TLB.Builder parensM Never = id @@ -2088,14 +2108,14 @@ foldHelp _ _ (ECompositeKey _, _) = throw (CompositeKeyErr FoldHelpError) foldHelp _ _ (_, ECompositeKey _) = throw (CompositeKeyErr FoldHelpError) foldHelp info (b0, vals0) (v1, v2) = - let (b1, vals1) = valueToSql v1 info + let (b1, vals1) = valueToSql v1 info (b2, vals2) = valueToSql v2 info in ( b0 <> " WHEN " <> b1 <> " THEN " <> b2, vals0 <> vals1 <> vals2 ) valueToSql :: SqlExpr (Value a) -> IdentInfo -> (TLB.Builder, [PersistValue]) valueToSql (ERaw p f) = (first (parensM p)) . f valueToSql (ECompositeKey _) = throw (CompositeKeyErr SqlCaseError) - valueToSql (EAliasedValue i _) = aliasedValueIdentToRawSql i + valueToSql (EAliasedValue i _) = aliasedValueIdentToRawSql i valueToSql (EValueReference i i') = valueReferenceToRawSql i i' -- | (Internal) Create a custom binary operator. You /should/ @@ -2119,7 +2139,7 @@ , vals1 <> vals2 ) unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b) where construct :: SqlExpr (Value a) -> SqlExpr (Value a) - construct (ERaw p f) = ERaw Parens $ \info -> + construct (ERaw p f) = ERaw (if p == Never then Parens else Never) $ \info -> let (b1, vals) = f info build ("?", [PersistList vals']) = (uncommas $ replicate (length vals') "?", vals') @@ -2127,10 +2147,10 @@ in build (parensM p b1, vals) construct (ECompositeKey f) = ERaw Parens $ \info -> (uncommas $ f info, mempty) - construct (EAliasedValue i _) = + construct (EAliasedValue i _) = ERaw Never $ aliasedValueIdentToRawSql i - construct (EValueReference i i') = - ERaw Never $ valueReferenceToRawSql i i' + construct (EValueReference i i') = + ERaw Never $ valueReferenceToRawSql i i' {-# INLINE unsafeSqlBinOp #-} @@ -2160,9 +2180,14 @@ -- a foreign (composite or not) key, so we enforce that it has -- no placeholders and split it on the commas. unsafeSqlBinOpComposite :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) -unsafeSqlBinOpComposite op _ a@(ERaw _ _) b@(ERaw _ _) = unsafeSqlBinOp op a b -unsafeSqlBinOpComposite op sep a b = ERaw Parens $ compose (listify a) (listify b) +unsafeSqlBinOpComposite op sep a b + | isCompositeKey a || isCompositeKey b = ERaw Parens $ compose (listify a) (listify b) + | otherwise = unsafeSqlBinOp op a b where + isCompositeKey :: SqlExpr (Value x) -> Bool + isCompositeKey (ECompositeKey _) = True + isCompositeKey _ = False + listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue]) listify (ECompositeKey f) = flip (,) [] . f listify (ERaw _ f) = deconstruct . f @@ -2190,6 +2215,13 @@ unsafeSqlValue v = ERaw Never $ const (v, mempty) {-# INLINE unsafeSqlValue #-} +valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue]) +valueToFunctionArg info v = + case v of + ERaw _ f -> f info + EAliasedValue i _ -> aliasedValueIdentToRawSql i info + EValueReference i i' -> valueReferenceToRawSql i i' info + ECompositeKey _ -> throw (CompositeKeyErr SqlFunctionError) -- | (Internal) A raw SQL function. Once again, the same warning -- from 'unsafeSqlBinOp' applies to this function as well. @@ -2197,15 +2229,8 @@ TLB.Builder -> a -> SqlExpr (Value b) unsafeSqlFunction name arg = ERaw Never $ \info -> - let - valueToFunctionArg v = - case v of - ERaw _ f -> f info - EAliasedValue i _ -> aliasedValueIdentToRawSql i info - EValueReference i i' -> valueReferenceToRawSql i i' info - ECompositeKey _ -> throw (CompositeKeyErr SqlFunctionError) - (argsTLB, argsVals) = - uncommas' $ map valueToFunctionArg $ toArgList arg + let (argsTLB, argsVals) = + uncommas' $ map (valueToFunctionArg info) $ toArgList arg in (name <> parens argsTLB, argsVals) -- | (Internal) An unsafe SQL function to extract a subfield from a compound @@ -2217,7 +2242,7 @@ unsafeSqlExtractSubField subField arg = ERaw Never $ \info -> let (argsTLB, argsVals) = - uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList arg + uncommas' $ map (valueToFunctionArg info) $ toArgList arg in ("EXTRACT" <> parens (subField <> " FROM " <> argsTLB), argsVals) -- | (Internal) A raw SQL function. Preserves parentheses around arguments. @@ -2226,8 +2251,15 @@ TLB.Builder -> a -> SqlExpr (Value b) unsafeSqlFunctionParens name arg = ERaw Never $ \info -> - let (argsTLB, argsVals) = - uncommas' $ map (\(ERaw p f) -> first (parensM p) (f info)) $ toArgList arg + let + valueToFunctionArgParens v = + case v of + ERaw p f -> first (parensM p) (f info) + EAliasedValue i _ -> aliasedValueIdentToRawSql i info + EValueReference i i' -> valueReferenceToRawSql i i' info + ECompositeKey _ -> throw (CompositeKeyErr SqlFunctionError) + (argsTLB, argsVals) = + uncommas' $ map valueToFunctionArgParens $ toArgList arg in (name <> parens argsTLB, argsVals) -- | (Internal) An explicit SQL type cast using CAST(value as type). @@ -2351,7 +2383,7 @@ veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f veryUnsafeCoerceSqlExprValue (ECompositeKey f) = ECompositeKey f veryUnsafeCoerceSqlExprValue (EAliasedValue i v) = EAliasedValue i (veryUnsafeCoerceSqlExprValue v) -veryUnsafeCoerceSqlExprValue (EValueReference i i') = EValueReference i i' +veryUnsafeCoerceSqlExprValue (EValueReference i i') = EValueReference i i' -- | (Internal) Coerce a value's type from 'SqlExpr (ValueList @@ -2624,11 +2656,6 @@ -- | Renders a 'SqlQuery' into a 'Text' value along with the list of -- 'PersistValue's that would be supplied to the database for @?@ placeholders. -- --- You must ensure that the 'Mode' you pass to this function corresponds with --- the actual 'SqlQuery'. If you pass a query that uses incompatible features --- (like an @INSERT@ statement with a @SELECT@ mode) then you'll get a weird --- result. --- -- @since 3.1.1 renderQuerySelect :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) @@ -2640,11 +2667,6 @@ -- | Renders a 'SqlQuery' into a 'Text' value along with the list of -- 'PersistValue's that would be supplied to the database for @?@ placeholders. -- --- You must ensure that the 'Mode' you pass to this function corresponds with --- the actual 'SqlQuery'. If you pass a query that uses incompatible features --- (like an @INSERT@ statement with a @SELECT@ mode) then you'll get a weird --- result. --- -- @since 3.1.1 renderQueryDelete :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) @@ -2656,11 +2678,6 @@ -- | Renders a 'SqlQuery' into a 'Text' value along with the list of -- 'PersistValue's that would be supplied to the database for @?@ placeholders. -- --- You must ensure that the 'Mode' you pass to this function corresponds with --- the actual 'SqlQuery'. If you pass a query that uses incompatible features --- (like an @INSERT@ statement with a @SELECT@ mode) then you'll get a weird --- result. --- -- @since 3.1.1 renderQueryUpdate :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) @@ -2672,11 +2689,6 @@ -- | Renders a 'SqlQuery' into a 'Text' value along with the list of -- 'PersistValue's that would be supplied to the database for @?@ placeholders. -- --- You must ensure that the 'Mode' you pass to this function corresponds with --- the actual 'SqlQuery'. If you pass a query that uses incompatible features --- (like an @INSERT@ statement with a @SELECT@ mode) then you'll get a weird --- result. --- -- @since 3.1.1 renderQueryInsertInto :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) @@ -2752,7 +2764,7 @@ , maybe mempty makeOnClause monClause ] mk _ (OnClause _) = throw (UnexpectedCaseErr MakeFromError) - mk _ (FromQuery ident f) = + mk _ (FromQuery ident f) = let (queryText, queryVals) = f info in ((parens queryText) <> " AS " <> useIdent info ident, queryVals) @@ -2796,7 +2808,7 @@ makeWhere info (Where v) = first ("\nWHERE " <>) $ x info where x = - case v of + case v of ERaw _ f -> f EAliasedValue i _ -> aliasedValueIdentToRawSql i EValueReference i i' -> valueReferenceToRawSql i i' @@ -2820,7 +2832,7 @@ makeHaving info (Where v) = first ("\nHAVING " <>) $ x info where x = - case v of + case v of ERaw _ f -> f EAliasedValue i _ -> aliasedValueIdentToRawSql i EValueReference i i' -> valueReferenceToRawSql i i' @@ -2837,11 +2849,11 @@ let fs = f info vals = repeat [] in zip (map (<> orderByType t) fs) vals - mk (EOrderBy t v) = + mk (EOrderBy t v) = let x = case v of ERaw p f -> (first (parensM p)) . f - EAliasedValue i _ -> aliasedValueIdentToRawSql i - EValueReference i i' -> valueReferenceToRawSql i i' + EAliasedValue i _ -> aliasedValueIdentToRawSql i + EValueReference i i' -> valueReferenceToRawSql i i' ECompositeKey _ -> undefined -- defined above in [ first (<> orderByType t) $ x info ] mk EOrderRandom = [first (<> "RANDOM()") mempty] @@ -2886,9 +2898,9 @@ valueReferenceToRawSql sourceIdent columnIdentF info = (useIdent info sourceIdent <> "." <> useIdent info (columnIdentF info), mempty) -aliasedEntityColumnIdent :: Ident -> FieldDef -> IdentInfo -> Ident -aliasedEntityColumnIdent (I baseIdent) field info = - I (baseIdent <> "_" <> (builderToText $ fromDBName info $ fieldDB field)) +aliasedEntityColumnIdent :: Ident -> FieldDef -> Ident +aliasedEntityColumnIdent (I baseIdent) field = + I (baseIdent <> "_" <> (unDBName $ fieldDB field)) aliasedColumnName :: Ident -> IdentInfo -> T.Text -> TLB.Builder aliasedColumnName (I baseIdent) info columnName = @@ -2941,6 +2953,11 @@ sqlSelectColCount _ = 1 sqlSelectProcessRow _ = Right () +unescapedColumnNames :: EntityDef -> [DBName] +unescapedColumnNames ent = + (if hasCompositeKey ent + then [] else [fieldDB (entityId ent)]) + <> map fieldDB (entityFields ent) -- | You may return an 'Entity' from a 'select' query. instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where @@ -2962,16 +2979,16 @@ where process ed = uncommas $ map ((name <>) . aliasName) $ - entityColumnNames ed (fst info) - aliasName columnName = (TLB.fromText columnName) <> " AS " <> aliasedColumnName aliasIdent info columnName + unescapedColumnNames ed + aliasName columnName = (fromDBName info columnName) <> " AS " <> aliasedColumnName aliasIdent info (unDBName columnName) name = useIdent info tableIdent <> "." ret = let ed = entityDef $ getEntityVal $ return expr in (process ed, mempty) sqlSelectCols info expr@(EAliasedEntityReference sourceIdent baseIdent) = ret where process ed = uncommas $ - map ((name <>) . aliasedColumnName baseIdent info) $ - entityColumnNames ed (fst info) + map ((name <>) . aliasedColumnName baseIdent info . unDBName) $ + unescapedColumnNames ed name = useIdent info sourceIdent <> "." ret = let ed = entityDef $ getEntityVal $ return expr in (process ed, mempty) @@ -3556,9 +3573,9 @@ . mconcat . mkInfo $ (sqlBackend, initialIdentState) - EAliasedValue i _ -> + EAliasedValue i _ -> builderToText $ useIdent (sqlBackend, initialIdentState) i - EValueReference i i' -> + EValueReference i i' -> let (builder, _) = valueReferenceToRawSql i i' (sqlBackend, initialIdentState) in (builderToText builder) -- | An exception thrown by 'RenderExpr' - it's not designed to handle composite diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/src/Database/Esqueleto/PostgreSQL.hs @@ -23,6 +23,7 @@ , upsertBy , insertSelectWithConflict , insertSelectWithConflictCount + , filterWhere -- * Internal , unsafeSqlAggregateFunction ) where @@ -38,7 +39,7 @@ import Database.Esqueleto.Internal.Internal (EsqueletoError(..), CompositeKeyError(..), UnexpectedCaseError(..), SetClause, Ident(..), uncommas, FinalResult(..), toUniqueDef, - KnowResult, renderUpdates) + KnowResult, renderUpdates, UnexpectedValueError(..)) import Database.Persist.Class (OnlyOneUniqueKey) import Data.List.NonEmpty ( NonEmpty( (:|) ) ) import Data.Int (Int64) @@ -298,3 +299,46 @@ ]),values) where (updatesTLB,values) = renderedUpdates conn + +-- | Allow aggregate functions to take a filter clause. +-- +-- Example of usage: +-- +-- @ +-- share [mkPersist sqlSettings] [persistLowerCase| +-- User +-- name Text +-- deriving Eq Show +-- Task +-- userId UserId +-- completed Bool +-- deriving Eq Show +-- |] +-- +-- select $ from $ \(users `InnerJoin` tasks) -> do +-- on $ users ^. UserId ==. tasks ^. TaskUserId +-- groupBy $ users ^. UserId +-- return +-- ( users ^. UserId +-- , count (tasks ^. TaskId) `filterWhere` (tasks ^. TaskCompleted ==. val True) +-- , count (tasks ^. TaskId) `filterWhere` (tasks ^. TaskCompleted ==. val False) +-- ) +-- @ +-- +-- @since 3.3.3.3 +filterWhere + :: SqlExpr (Value a) + -- ^ Aggregate function + -> SqlExpr (Value Bool) + -- ^ Filter clause + -> SqlExpr (Value a) +filterWhere aggExpr clauseExpr = ERaw Never $ \info -> + let (aggBuilder, aggValues) = case aggExpr of + ERaw _ aggF -> aggF info + ECompositeKey _ -> throw $ CompositeKeyErr FilterWhereAggError + (clauseBuilder, clauseValues) = case clauseExpr of + ERaw _ clauseF -> clauseF info + ECompositeKey _ -> throw $ CompositeKeyErr FilterWhereClauseError + in ( aggBuilder <> " FILTER (WHERE " <> clauseBuilder <> ")" + , aggValues <> clauseValues + ) diff --git a/test/Common/Test.hs b/test/Common/Test.hs --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -894,6 +894,21 @@ ret <- select $ Experimental.from $ SelectQuery q liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ] + it "supports sub-selecting Maybe entities" $ do + run $ do + l1e <- insert' l1 + l3e <- insert' l3 + l1Deeds <- mapM (\k -> insert' $ Deed k (entityKey l1e)) (map show [1..3 :: Int]) + let l1WithDeeds = do d <- l1Deeds + pure (l1e, Just d) + ret <- select $ Experimental.from $ SelectQuery $ do + (lords :& deeds) <- + Experimental.from $ Table @Lord + `LeftOuterJoin` Table @Deed + `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId) + pure (lords, deeds) + liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds) + it "lets you order by alias" $ do run $ do _ <- insert' p1 diff --git a/test/MySQL/Test.hs b/test/MySQL/Test.hs --- a/test/MySQL/Test.hs +++ b/test/MySQL/Test.hs @@ -2,6 +2,7 @@ , FlexibleContexts , RankNTypes , TypeFamilies + , TypeApplications #-} module Main (main) where @@ -17,13 +18,14 @@ , connectPassword , defaultConnectInfo) import Database.Esqueleto +import Database.Esqueleto.Experimental hiding (from, on) +import qualified Database.Esqueleto.Experimental as Experimental import qualified Control.Monad.Trans.Resource as R import Test.Hspec import Common.Test - -- testMysqlRandom :: Spec -- testMysqlRandom = do -- -- This is known not to work until @@ -162,7 +164,32 @@ nameContains like "iv" [p4e] +testMysqlUnionWithLimits :: Spec +testMysqlUnionWithLimits = do + describe "MySQL Union" $ do + it "supports limit/orderBy by parenthesizing" $ do + run $ do + mapM_ (insert . Foo) [1..6] + let q1 = do + foo <- Experimental.from $ Table @Foo + where_ $ foo ^. FooName <=. val 3 + orderBy [asc $ foo ^. FooName] + limit 2 + pure $ foo ^. FooName + + let q2 = do + foo <- Experimental.from $ Table @Foo + where_ $ foo ^. FooName >. val 3 + orderBy [asc $ foo ^. FooName] + limit 2 + pure $ foo ^. FooName + + + ret <- select $ Experimental.from $ SelectQuery q1 `Union` SelectQuery q2 + liftIO $ ret `shouldMatchList` [Value 1, Value 2, Value 4, Value 5] + + main :: IO () main = do hspec $ do @@ -180,6 +207,7 @@ testMysqlCoalesce testMysqlUpdate testMysqlTextFunctions + testMysqlUnionWithLimits diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -1082,6 +1082,75 @@ liftIO $ map entityVal uniques1 `shouldBe` test liftIO $ map entityVal uniques2 `shouldBe` test2 +testFilterWhere :: Spec +testFilterWhere = + describe "filterWhere" $ do + it "adds a filter clause to count aggregation" $ run $ do + -- Person "John" (Just 36) Nothing 1 + _ <- insert p1 + -- Person "Rachel" Nothing (Just 37) 2 + _ <- insert p2 + -- Person "Mike" (Just 17) Nothing 3 + _ <- insert p3 + -- Person "Livia" (Just 17) (Just 18) 4 + _ <- insert p4 + -- Person "Mitch" Nothing Nothing 5 + _ <- insert p5 + + usersByAge <- (fmap . fmap) (\(Value a, Value b, Value c) -> (a, b, c)) <$> select $ from $ \users -> do + groupBy $ users ^. PersonAge + return + ( users ^. PersonAge + -- Nothing: [Rachel { favNum = 2 }, Mitch { favNum = 5 }] = 2 + -- Just 36: [John { favNum = 1 } (excluded)] = 0 + -- Just 17: [Mike { favNum = 3 }, Livia { favNum = 4 }] = 2 + , count (users ^. PersonId) `EP.filterWhere` (users ^. PersonFavNum >=. val 2) + -- Nothing: [Rachel { favNum = 2 } (excluded), Mitch { favNum = 5 } (excluded)] = 0 + -- Just 36: [John { favNum = 1 }] = 1 + -- Just 17: [Mike { favNum = 3 } (excluded), Livia { favNum = 4 } (excluded)] = 0 + , count (users ^. PersonFavNum) `EP.filterWhere` (users ^. PersonFavNum <. val 2) + ) + + liftIO $ usersByAge `shouldMatchList` + ( [ (Nothing, 2, 0) + , (Just 36, 0, 1) + , (Just 17, 2, 0) + ] :: [(Maybe Int, Int, Int)] + ) + + it "adds a filter clause to sum aggregation" $ run $ do + -- Person "John" (Just 36) Nothing 1 + _ <- insert p1 + -- Person "Rachel" Nothing (Just 37) 2 + _ <- insert p2 + -- Person "Mike" (Just 17) Nothing 3 + _ <- insert p3 + -- Person "Livia" (Just 17) (Just 18) 4 + _ <- insert p4 + -- Person "Mitch" Nothing Nothing 5 + _ <- insert p5 + + usersByAge <- (fmap . fmap) (\(Value a, Value b, Value c) -> (a, b, c)) <$> select $ from $ \users -> do + groupBy $ users ^. PersonAge + return + ( users ^. PersonAge + -- Nothing: [Rachel { favNum = 2 }, Mitch { favNum = 5 }] = Just 7 + -- Just 36: [John { favNum = 1 } (excluded)] = Nothing + -- Just 17: [Mike { favNum = 3 }, Livia { favNum = 4 }] = Just 7 + , sum_ (users ^. PersonFavNum) `EP.filterWhere` (users ^. PersonFavNum >=. val 2) + -- Nothing: [Rachel { favNum = 2 } (excluded), Mitch { favNum = 5 } (excluded)] = Nothing + -- Just 36: [John { favNum = 1 }] = Just 1 + -- Just 17: [Mike { favNum = 3 } (excluded), Livia { favNum = 4 } (excluded)] = Nothing + , sum_ (users ^. PersonFavNum) `EP.filterWhere` (users ^. PersonFavNum <. val 2) + ) + + liftIO $ usersByAge `shouldMatchList` + ( [ (Nothing, Just 7, Nothing) + , (Just 36, Nothing, Just 1) + , (Just 17, Just 7, Nothing) + ] :: [(Maybe Int, Maybe Rational, Maybe Rational)] + ) + type JSONValue = Maybe (JSONB A.Value) createSaneSQL :: (PersistField a) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> IO () @@ -1156,6 +1225,7 @@ testInsertUniqueViolation testUpsert testInsertSelectWithConflict + testFilterWhere describe "PostgreSQL JSON tests" $ do -- NOTE: We only clean the table once, so we -- can use its contents across all JSON tests