esqueleto 3.3.3.2 → 3.3.3.3

raw patch · 8 files changed

+301/−90 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.md +12/−0
• esqueleto.cabal +1/−1
• src/Database/Esqueleto/Experimental.hs +33/−8
• src/Database/Esqueleto/Internal/Internal.hs +96/−79
• src/Database/Esqueleto/PostgreSQL.hs +45/−1
• test/Common/Test.hs +15/−0
• test/MySQL/Test.hs +29/−1
• test/PostgreSQL/Test.hs +70/−0

@@ -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

@@ -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.                 .

@@ -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) 

@@ -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

@@ -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+     )

@@ -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

@@ -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   

@@ -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