esqueleto 3.5.13.1 → 3.5.13.2
raw patch · 9 files changed
+259/−132 lines, 9 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- changelog.md +15/−0
- esqueleto.cabal +2/−1
- src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs +5/−1
- src/Database/Esqueleto/Internal/Internal.hs +119/−5
- src/Database/Esqueleto/Record.hs +26/−113
- test/Common/Test.hs +47/−10
- test/Common/Test/CTE.hs +35/−0
- test/Common/Test/Models.hs +10/−0
- test/PostgreSQL/Test.hs +0/−2
changelog.md view
@@ -1,3 +1,18 @@+3.5.13.2+========+- @blujupiter32+ - [#379](https://github.com/bitemyapp/esqueleto/pull/379)+ - Fix a bug where `not_ (a &&. b)` would be interpeted as `(not_ a) &&. b`+- @RikvanToor+ - [#373](https://github.com/bitemyapp/esqueleto/pull/373), [#410](https://github.com/bitemyapp/esqueleto/pull/410)+ - Fix name clashes when using CTEs multiple times+- @TeofilC+ - [#394](https://github.com/bitemyapp/esqueleto/pull/394)+ - Use TH quotes to eliminate some CPP.+- @parsonsmatt, @jappeace+ - [#346](#https://github.com/bitemyapp/esqueleto/pull/346), [#411](https://github.com/bitemyapp/esqueleto/pull/411)+ - Add docs for more SQL operators+ 3.5.13.1 ======== - @csamak
esqueleto.cabal view
@@ -2,7 +2,7 @@ name: esqueleto -version: 3.5.13.1+version: 3.5.13.2 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. .@@ -87,6 +87,7 @@ main-is: Spec.hs other-modules: Common.Test+ Common.Test.CTE Common.Test.Models Common.Test.Import Common.Test.Select
src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs view
@@ -53,7 +53,11 @@ let clause = CommonTableExpressionClause NormalCommonTableExpression ident (\info -> toRawSql SELECT info aliasedQuery) Q $ W.tell mempty{sdCteClause = [clause]} ref <- toAliasReference ident aliasedValue- pure $ From $ pure (ref, (\_ info -> (useIdent info ident, mempty)))+ pure $ From $ do+ newIdent <- newIdentFor (DBName "cte")+ localRef <- toAliasReference newIdent ref+ let makeLH info = useIdent info ident <> " AS " <> useIdent info newIdent+ pure (localRef, (\_ info -> (makeLH info, mempty))) -- | @WITH@ @RECURSIVE@ allows one to make a recursive subquery, which can -- reference itself. Like @WITH@, this is supported in most modern SQL engines.
src/Database/Esqueleto/Internal/Internal.hs view
@@ -717,53 +717,167 @@ countDistinct = countHelper "(DISTINCT " ")" not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool)-not_ v = ERaw noMeta $ \p info -> first ("NOT " <>) $ x p info+not_ v = ERaw noMeta (const $ first ("NOT " <>) . x) where- x p info =+ x info = case v of ERaw m f -> if hasCompositeKeyMeta m then throw (CompositeKeyErr NotError) else- let (b, vals) = f Never info- in (parensM p b, vals)+ f Parens info +-- | This operator produces the SQL operator @=@, which is used to compare+-- values for equality.+--+-- Example:+--+-- @+-- query :: UserId -> SqlPersistT IO [Entity User]+-- query userId = select $ do+-- user <- from $ table \@User+-- where_ (user ^. UserId ==. val userId)+-- pure user+-- @+--+-- This would generate the following SQL:+--+-- @+-- SELECT user.*+-- FROM user+-- WHERE user.id = ?+-- @ (==.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) (==.) = unsafeSqlBinOpComposite " = " " AND " +-- | This operator translates to the SQL operator @>=@.+--+-- Example:+--+-- @+-- where_ $ user ^. UserAge >=. val 21+-- @ (>=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) (>=.) = unsafeSqlBinOp " >= " +-- | This operator translates to the SQL operator @>@.+--+-- Example:+--+-- @+-- where_ $ user ^. UserAge >. val 20+-- @ (>.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) (>.) = unsafeSqlBinOp " > " +-- | This operator translates to the SQL operator @<=@.+--+-- Example:+--+-- @+-- where_ $ val 21 <=. user ^. UserAge+-- @ (<=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) (<=.) = unsafeSqlBinOp " <= " +-- | This operator translates to the SQL operator @<@.+--+-- Example:+--+-- @+-- where_ $ val 20 <. user ^. UserAge+-- @ (<.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) (<.) = unsafeSqlBinOp " < "++-- | This operator translates to the SQL operator @!=@.+--+-- Example:+--+-- @+-- where_ $ user ^. UserName !=. val "Bob"+-- @ (!=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) (!=.) = unsafeSqlBinOpComposite " != " " OR " +-- | This operator translates to the SQL operator @AND@.+--+-- Example:+--+-- @+-- where_ $+-- user ^. UserName ==. val "Matt"+-- &&. user ^. UserAge >=. val 21+-- @ (&&.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) (&&.) = unsafeSqlBinOp " AND " +-- | This operator translates to the SQL operator @AND@.+--+-- Example:+--+-- @+-- where_ $+-- user ^. UserName ==. val "Matt"+-- ||. user ^. UserName ==. val "John"+-- @ (||.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) (||.) = unsafeSqlBinOp " OR " +-- | This operator translates to the SQL operator @+@.+--+-- This does not require or assume anything about the SQL values. Interpreting+-- what @+.@ means for a given type is left to the database engine.+--+-- Example:+--+-- @+-- user ^. UserAge +. val 10+-- @ (+.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) (+.) = unsafeSqlBinOp " + " +-- | This operator translates to the SQL operator @-@.+--+-- This does not require or assume anything about the SQL values. Interpreting+-- what @-.@ means for a given type is left to the database engine.+--+-- Example:+--+-- @+-- user ^. UserAge -. val 10+-- @ (-.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) (-.) = unsafeSqlBinOp " - " +-- | This operator translates to the SQL operator @/@.+--+-- This does not require or assume anything about the SQL values. Interpreting+-- what @/.@ means for a given type is left to the database engine.+--+-- Example:+--+-- @+-- user ^. UserAge /. val 10+-- @ (/.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) (/.) = unsafeSqlBinOp " / " +-- | This operator translates to the SQL operator @*@.+--+-- This does not require or assume anything about the SQL values. Interpreting+-- what @*.@ means for a given type is left to the database engine.+--+-- Example:+--+-- @+-- user ^. UserAge *. val 10+-- @ (*.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) (*.) = unsafeSqlBinOp " * " --- | @BETWEEN@.+-- | @a `between` (b, c)@ translates to the SQL expression @a >= b AND a <= c@.+-- It does not use a SQL @BETWEEN@ operator. -- -- @since: 3.1.0 between :: PersistField a => SqlExpr (Value a) -> (SqlExpr (Value a), SqlExpr (Value a)) -> SqlExpr (Value Bool)
src/Database/Esqueleto/Record.hs view
@@ -379,15 +379,12 @@ sqlSelectProcessRowDec' <- sqlSelectProcessRowDec info let overlap = Nothing instanceConstraints = []- instanceType =- (ConT ''SqlSelect)- `AppT` (ConT sqlName)- `AppT` (ConT name)+ instanceType <- [t| SqlSelect $(conT sqlName) $(conT name) |] - pure $ InstanceD overlap instanceConstraints instanceType [sqlSelectColsDec', sqlSelectColCountDec', sqlSelectProcessRowDec']+ pure $ InstanceD overlap instanceConstraints instanceType (sqlSelectColsDec' ++ sqlSelectColCountDec' ++ [ sqlSelectProcessRowDec']) -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance.-sqlSelectColsDec :: RecordInfo -> Q Dec+sqlSelectColsDec :: RecordInfo -> Q [Dec] sqlSelectColsDec RecordInfo {..} = do -- Pairs of record field names and local variable names. fieldNames <- forM sqlFields (\(name', _type) -> do@@ -413,26 +410,12 @@ in foldl' helper (VarE f1) rest identInfo <- newName "identInfo"- -- Roughly:- -- sqlSelectCols $identInfo SqlFoo{..} = sqlSelectCols $identInfo $joinedFields- pure $- FunD- 'sqlSelectCols- [ Clause- [ VarP identInfo- , RecP sqlName fieldPatterns- ]- ( NormalB $- (VarE 'sqlSelectCols)- `AppE` (VarE identInfo)- `AppE` (ParensE joinedFields)- )- -- `where` clause.- []- ]+ [d| $(varP 'sqlSelectCols) = \ $(varP identInfo) $(pure $ RecP sqlName fieldPatterns) ->+ sqlSelectCols $(varE identInfo) $(pure joinedFields)+ |] -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance.-sqlSelectColCountDec :: RecordInfo -> Q Dec+sqlSelectColCountDec :: RecordInfo -> Q [Dec] sqlSelectColCountDec RecordInfo {..} = do let joinedTypes = case snd `map` sqlFields of@@ -442,23 +425,7 @@ InfixT lhs ''(:&) ty in foldl' helper t1 rest - -- Roughly:- -- sqlSelectColCount _ = sqlSelectColCount (Proxy @($joinedTypes))- pure $- FunD- 'sqlSelectColCount- [ Clause- [WildP]- ( NormalB $- AppE (VarE 'sqlSelectColCount) $- ParensE $- AppTypeE- (ConE 'Proxy)- joinedTypes- )- -- `where` clause.- []- ]+ [d| $(varP 'sqlSelectColCount) = \ _ -> sqlSelectColCount (Proxy @($(pure joinedTypes))) |] -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect` -- instance.@@ -541,11 +508,7 @@ `AppT` ((ConT ((==) ''Entity -> True)) `AppT` _innerType) -> pure $ VarP var -- x -> Value var-#if MIN_VERSION_template_haskell(2,18,0)- _ -> pure $ ConP 'Value [] [VarP var]-#else- _ -> pure $ ConP 'Value [VarP var]-#endif+ _ -> [p| Value $(varP var) |] -- Given a type, find the corresponding SQL type. --@@ -766,7 +729,7 @@ instanceConstraints = [] instanceType = (ConT ''ToMaybe) `AppT` (ConT sqlName) - pure $ InstanceD overlap instanceConstraints instanceType [toMaybeTDec', toMaybeDec']+ pure $ InstanceD overlap instanceConstraints instanceType (toMaybeTDec' ++ toMaybeDec') -- | Generates a `ToMaybe` instance for the SqlMaybe of the given record. makeSqlMaybeToMaybeInstance :: RecordInfo -> Q Dec@@ -776,25 +739,15 @@ overlap = Nothing instanceConstraints = [] instanceType = (ConT ''ToMaybe) `AppT` (ConT sqlMaybeName)- pure $ InstanceD overlap instanceConstraints instanceType [sqlMaybeToMaybeTDec', toMaybeIdDec]+ pure $ InstanceD overlap instanceConstraints instanceType (toMaybeIdDec:sqlMaybeToMaybeTDec') -- | Generates a `type ToMaybeT ... = ...` declaration for the given names.-toMaybeTDec :: Name -> Name -> Q Dec-toMaybeTDec nameLeft nameRight = do- pure $ mkTySynInstD ''ToMaybeT (ConT nameLeft) (ConT nameRight)- where- mkTySynInstD className lhsArg rhs =-#if MIN_VERSION_template_haskell(2,15,0)- let binders = Nothing- lhs = ConT className `AppT` lhsArg- in- TySynInstD $ TySynEqn binders lhs rhs-#else- TySynInstD className $ TySynEqn [lhsArg] rhs-#endif+toMaybeTDec :: Name -> Name -> Q [Dec]+toMaybeTDec nameLeft nameRight =+ [d| type instance ToMaybeT $(conT nameLeft) = $(conT nameRight) |] -- | Generates a `toMaybe value = ...` declaration for the given record.-toMaybeDec :: RecordInfo -> Q Dec+toMaybeDec :: RecordInfo -> Q [Dec] toMaybeDec RecordInfo {..} = do (fieldPatterns, fieldExps) <- unzip <$> forM (zip sqlFields sqlMaybeFields) (\((fieldName', _), (maybeFieldName', _)) -> do@@ -804,15 +757,9 @@ , (maybeFieldName', VarE 'toMaybe `AppE` VarE fieldPatternName) )) - pure $- FunD- 'toMaybe- [ Clause- [ RecP sqlName fieldPatterns- ]- (NormalB $ RecConE sqlMaybeName fieldExps)- []- ]+ [d| $(varP 'toMaybe) = \ $(pure $ RecP sqlName fieldPatterns) ->+ $(pure $ RecConE sqlMaybeName fieldExps)+ |] -- | Generates an `SqlSelect` instance for the given record and its -- @Sql@-prefixed variant.@@ -823,15 +770,11 @@ sqlSelectProcessRowDec' <- sqlMaybeSelectProcessRowDec info let overlap = Nothing instanceConstraints = []- instanceType =- (ConT ''SqlSelect)- `AppT` (ConT sqlMaybeName)- `AppT` (AppT (ConT ''Maybe) (ConT name))-- pure $ InstanceD overlap instanceConstraints instanceType [sqlSelectColsDec', sqlSelectColCountDec', sqlSelectProcessRowDec']+ instanceType <- [t| SqlSelect $(conT sqlMaybeName) (Maybe $(conT name)) |]+ pure $ InstanceD overlap instanceConstraints instanceType (sqlSelectColsDec' ++ sqlSelectColCountDec' ++ [sqlSelectProcessRowDec']) -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance.-sqlMaybeSelectColsDec :: RecordInfo -> Q Dec+sqlMaybeSelectColsDec :: RecordInfo -> Q [Dec] sqlMaybeSelectColsDec RecordInfo {..} = do -- Pairs of record field names and local variable names. fieldNames <- forM sqlMaybeFields (\(name', _type) -> do@@ -857,23 +800,9 @@ in foldl' helper (VarE f1) rest identInfo <- newName "identInfo"- -- Roughly:- -- sqlSelectCols $identInfo SqlFoo{..} = sqlSelectCols $identInfo $joinedFields- pure $- FunD- 'sqlSelectCols- [ Clause- [ VarP identInfo- , RecP sqlMaybeName fieldPatterns- ]- ( NormalB $- (VarE 'sqlSelectCols)- `AppE` (VarE identInfo)- `AppE` (ParensE joinedFields)- )- -- `where` clause.- []- ]+ [d| $(varP 'sqlSelectCols) = \ $(varP identInfo) $(pure $ RecP sqlMaybeName fieldPatterns) ->+ sqlSelectCols $(varE identInfo) $(pure joinedFields)+ |] -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect` -- instance for a SqlMaybe.@@ -939,7 +868,7 @@ _ -> id -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance.-sqlMaybeSelectColCountDec :: RecordInfo -> Q Dec+sqlMaybeSelectColCountDec :: RecordInfo -> Q [Dec] sqlMaybeSelectColCountDec RecordInfo {..} = do let joinedTypes = case snd `map` sqlMaybeFields of@@ -949,23 +878,7 @@ InfixT lhs ''(:&) ty in foldl' helper t1 rest - -- Roughly:- -- sqlSelectColCount _ = sqlSelectColCount (Proxy @($joinedTypes))- pure $- FunD- 'sqlSelectColCount- [ Clause- [WildP]- ( NormalB $- AppE (VarE 'sqlSelectColCount) $- ParensE $- AppTypeE- (ConE 'Proxy)- joinedTypes- )- -- `where` clause.- []- ]+ [d| $(varP 'sqlSelectColCount) = \_ -> sqlSelectColCount (Proxy @($(pure joinedTypes))) |] -- | Statefully parse some number of columns from a list of `PersistValue`s, -- where the number of columns to parse is determined by `sqlSelectColCount`
test/Common/Test.hs view
@@ -91,6 +91,7 @@ import Common.Record (testDeriveEsqueletoRecord) import Common.Test.Select+import qualified Common.Test.CTE as CTESpec -- Test schema -- | this could be achieved with S.fromList, but not all lists@@ -878,16 +879,6 @@ return p asserting $ ret `shouldBe` [ p1e ] - itDb "works for a simple example with (>.) and not_ [uses just . val]" $ do- _ <- insert' p1- _ <- insert' p2- p3e <- insert' p3- ret <- select $- from $ \p -> do- where_ (not_ $ p ^. PersonAge >. just (val 17))- return p- asserting $ ret `shouldBe` [ p3e ]- describe "when using between" $ do itDb "works for a simple example with [uses just . val]" $ do p1e <- insert' p1@@ -921,6 +912,51 @@ , val $ PointKey 5 6 ) asserting $ ret `shouldBe` [()] + describe "when using not_" $ do+ itDb "works for a single expression" $ do+ ret <-+ select $+ pure $ not_ $ val True+ asserting $ do+ ret `shouldBe` [Value False]++ itDb "works for a simple example with (>.) [uses just . val]" $ do+ _ <- insert' p1+ _ <- insert' p2+ p3e <- insert' p3+ ret <- select $+ from $ \p -> do+ where_ (not_ $ p ^. PersonAge >. just (val 17))+ return p+ asserting $ ret `shouldBe` [ p3e ]+ itDb "works with (==.) and (||.)" $ do+ _ <- insert' p1+ _ <- insert' p2+ p3e <- insert' p3+ ret <- select $+ from $ \p -> do+ where_ (not_ $ p ^. PersonName ==. val "John" ||. p ^. PersonName ==. val "Rachel")+ return p+ asserting $ ret `shouldBe` [ p3e ]+ itDb "works with (>.), (<.) and (&&.) [uses just . val]" $ do+ p1e <- insert' p1+ _ <- insert' p2+ _ <- insert' p3+ ret <- select $+ from $ \p -> do+ where_ (not_ $ (p ^. PersonAge >. just (val 10)) &&. (p ^. PersonAge <. just (val 30)))+ return p+ asserting $ ret `shouldBe` [ p1e ]+ itDb "works with between [uses just . val]" $ do+ _ <- insert' p1+ _ <- insert' p2+ p3e <- insert' p3+ ret <- select $+ from $ \p -> do+ where_ (not_ $ (p ^. PersonAge) `between` (just $ val 20, just $ val 40))+ return p+ asserting $ ret `shouldBe` [ p3e ]+ itDb "works with avg_" $ do _ <- insert' p1 _ <- insert' p2@@ -2391,6 +2427,7 @@ testLocking testOverloadedRecordDot testDeriveEsqueletoRecord+ CTESpec.testCTE insert' :: ( Functor m , BaseBackend backend ~ PersistEntityBackend val
+ test/Common/Test/CTE.hs view
@@ -0,0 +1,35 @@+{-# language TypeApplications #-}++module Common.Test.CTE where++import Common.Test.Models+import Common.Test.Import+import Database.Persist.TH++testCTE :: SpecDb+testCTE = describe "CTE" $ do+ itDb "can refer to the same CTE twice" $ do+ let q :: SqlQuery (SqlExpr (Value Int), SqlExpr (Value Int))+ q = do+ bCte <- with $ do+ b <- from $ table @B+ pure b++ a :& b1 :& b2 <- from $+ table @A+ `innerJoin` bCte+ `on` do+ \(a :& b) ->+ a ^. AK ==. b ^. BK+ `innerJoin` bCte+ `on` do+ \(a :& _ :& b2) ->+ a ^. AK ==. b2 ^. BK+ pure (a ^. AK, a ^. AV +. b1 ^. BV +. b2 ^. BV)+ insert_ $ A { aK = 1, aV = 2 }+ insert_ $ B { bK = 1, bV = 3 }+ ret <- select q+ asserting $ do+ ret `shouldMatchList`+ [ (Value 1, Value (2 + 3 + 3))+ ]
test/Common/Test/Models.hs view
@@ -182,6 +182,16 @@ address String deriving Show deriving Eq++ A+ k Int+ v Int+ Primary k++ B+ k Int+ v Int+ Primary k |] -- Unique Test schema
test/PostgreSQL/Test.hs view
@@ -1347,7 +1347,6 @@ EP.forUpdateOf p EP.skipLocked return p - liftIO $ print nonLockedRowsSpecifiedTable pure $ length nonLockedRowsSpecifiedTable `shouldBe` 2 withAsync sideThread $ \sideThreadAsync -> do@@ -1371,7 +1370,6 @@ EP.forUpdateOf p EP.skipLocked return p - liftIO $ print nonLockedRowsAfterUpdate asserting sideThreadAsserts asserting $ length nonLockedRowsAfterUpdate `shouldBe` 3