From b295bc6a5f2a221b074940c01d4590d865774fe0 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 26 May 2021 14:27:04 -0600 Subject: [PATCH] Esqueleto.Legacy (#259) * Esqueleto.Legacy * Add changelog entry * Delete deprecated modules * a bit more * ghc 9 support, clean warns * yes * okkk --- .github/workflows/haskell.yml | 4 +- changelog.md | 23 +- esqueleto.cabal | 4 +- src/Database/Esqueleto.hs | 17 +- src/Database/Esqueleto/Experimental.hs | 7 +- src/Database/Esqueleto/Experimental/From.hs | 12 +- .../Esqueleto/Experimental/From/Join.hs | 68 ++- .../Experimental/From/SqlSetOperation.hs | 13 +- src/Database/Esqueleto/Internal/Internal.hs | 147 +++---- src/Database/Esqueleto/Internal/Language.hs | 140 ------ .../Esqueleto/Internal/PersistentImport.hs | 1 - src/Database/Esqueleto/Internal/Sql.hs | 78 ---- src/Database/Esqueleto/Legacy.hs | 415 ++++++++++++++++++ src/Database/Esqueleto/PostgreSQL.hs | 8 +- src/Database/Esqueleto/PostgreSQL/JSON.hs | 3 +- .../Esqueleto/PostgreSQL/JSON/Instances.hs | 3 +- test/Common/Test.hs | 8 +- test/PostgreSQL/Test.hs | 108 ++--- 18 files changed, 626 insertions(+), 433 deletions(-) delete mode 100644 src/Database/Esqueleto/Internal/Language.hs delete mode 100644 src/Database/Esqueleto/Internal/Sql.hs create mode 100644 src/Database/Esqueleto/Legacy.hs diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 7681cba..0e35226 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -33,7 +33,7 @@ jobs: strategy: matrix: cabal: ["3.4"] - ghc: ["8.6.5", "8.8.4", "8.10.4"] + ghc: ["8.6.5", "8.8.4", "8.10.4", "9.0.1"] env: CONFIG: "--enable-tests --enable-benchmarks " steps: @@ -71,6 +71,6 @@ jobs: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} ${{ runner.os }}-${{ matrix.ghc }}- - run: cabal v2-build --disable-optimization -j $CONFIG - - run: cabal v2-test --disable-optimization -j $CONFIG + - run: cabal v2-test --disable-optimization -j $CONFIG --test-options "--fail-on-focus" - run: cabal v2-haddock -j $CONFIG - run: cabal v2-sdist diff --git a/changelog.md b/changelog.md index 577cf0e..34709c3 100644 --- a/changelog.md +++ b/changelog.md @@ -1,14 +1,27 @@ 3.5.0.0 -======= +======= - @belevy - [#228](https://github.com/bitemyapp/esqueleto/pull/228) - - Destroy all GADTs; Removes the From GADT and SqlExpr GADT - - From GADT is replaced with a From data type and FromRaw + - Destroy all GADTs; Removes the From GADT and SqlExpr GADT + - From GADT is replaced with a From data type and FromRaw - SqlExpr is now all defined in terms of ERaw - - Modified ERaw to contain a SqlExprMeta with any extra information + - Modified ERaw to contain a SqlExprMeta with any extra information that may be needed - - Experimental top level is now strictly for documentation and all the + - Experimental top level is now strictly for documentation and all the implementation details are in Experimental.* modules +- @parsonsmatt + - [#259](https://github.com/bitemyapp/esqueleto/pull/259) + - Create the `Database.Esqueleto.Legacy` module. The + `Database.Esqueleto` module now emits a warning, directing users to + either import `Database.Esqueleto.Legacy` to keep the old behavior or + to import `Database.Esqueleto.Experimental` to opt in to the new + behavior. + - Deleted the deprecated modules + `Database.Esqueleto.Internal.{Language,Sql}`. Please use + `Database.Esqueleto.Internal.Internal` instead, or ideally post what + you need from the library so we can support you safely. + - Support GHC 9 + 3.4.2.2 ======= - @parsonsmatt diff --git a/esqueleto.cabal b/esqueleto.cabal index 6338dfd..b5d3fed 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -29,9 +29,8 @@ source-repository head library exposed-modules: Database.Esqueleto + Database.Esqueleto.Legacy Database.Esqueleto.Experimental - Database.Esqueleto.Internal.Language - Database.Esqueleto.Internal.Sql Database.Esqueleto.Internal.Internal Database.Esqueleto.Internal.ExprParser Database.Esqueleto.MySQL @@ -76,7 +75,6 @@ library -Wpartial-fields -Wmissing-home-modules -Widentities - -Wredundant-constraints -Wcpp-undef -Wcpp-undef -Wmonomorphism-restriction diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 2b7a50d..f7ab0e9 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} + -- | The @esqueleto@ EDSL (embedded domain specific language). -- This module replaces @Database.Persist@, so instead of -- importing that module you should just import this one: @@ -31,11 +32,15 @@ -- Other than identifier name clashes, @esqueleto@ does not -- conflict with @persistent@ in any way. -- --- Note that the faciliites for @JOIN@ have been significantly improved in the +-- Note that the facilities for @JOIN@ have been significantly improved in the -- "Database.Esqueleto.Experimental" module. The definition of 'from' and 'on' -- in this module will be replaced with those at the 4.0.0.0 version, so you are -- encouraged to migrate to the new method. -module Database.Esqueleto +-- +-- This module has an attached WARNING message indicating that the Experimental +-- syntax will become the default. If you want to continue using the old syntax, +-- please refer to "Database.Esqueleto.Legacy" as a drop-in replacement. +module Database.Esqueleto {-# WARNING "This module will switch over to the Experimental syntax in an upcoming major version release. Please migrate to the Database.Esqueleto.Legacy module to continue using the old syntax, or translate to the new and improved syntax in Database.Esqueleto.Experimental." #-} ( -- * Setup -- $setup @@ -123,14 +128,8 @@ module Database.Esqueleto , module Database.Esqueleto.Internal.PersistentImport ) where -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Trans.Reader (ReaderT) -import Data.Int (Int64) -import qualified Data.Map.Strict as Map -import Database.Esqueleto.Internal.Language +import Database.Esqueleto.Legacy import Database.Esqueleto.Internal.PersistentImport -import Database.Esqueleto.Internal.Sql -import qualified Database.Persist -- $setup diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs index b3c575b..c2e3a56 100644 --- a/src/Database/Esqueleto/Experimental.hs +++ b/src/Database/Esqueleto/Experimental.hs @@ -4,8 +4,8 @@ -- Haskell. The old method was a bit finicky and could permit runtime errors, -- and this new way is both significantly safer and much more powerful. -- --- Esqueleto users are encouraged to migrate to this module, as it will become --- the default in a new major version @4.0.0.0@. +-- This syntax will become the default syntax exported from the library in +-- version @3.6.0.0@. To use the old syntax, see "Database.Esqueleto.Legacy". module Database.Esqueleto.Experimental ( -- * Setup -- $setup @@ -229,9 +229,6 @@ import Database.Esqueleto.Experimental.ToAlias import Database.Esqueleto.Experimental.ToAliasReference import Database.Esqueleto.Experimental.ToMaybe -import GHC.TypeLits -import Database.Persist (EntityNameDB(..)) - -- $setup -- -- If you're already using "Database.Esqueleto", then you can get diff --git a/src/Database/Esqueleto/Experimental/From.hs b/src/Database/Esqueleto/Experimental/From.hs index c170283..2f1bb7d 100644 --- a/src/Database/Esqueleto/Experimental/From.hs +++ b/src/Database/Esqueleto/Experimental/From.hs @@ -18,8 +18,6 @@ module Database.Esqueleto.Experimental.From where -import Control.Arrow (first) -import Control.Monad (ap) import qualified Control.Monad.Trans.Writer as W import Data.Coerce (coerce) import Data.Proxy @@ -56,7 +54,7 @@ type RawFn = NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) -- the FromRaw FromClause constructor directly when converting -- from a @From@ to a @SqlQuery@ using @from@ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 newtype From a = From { unFrom :: SqlQuery (a, RawFn)} @@ -66,13 +64,13 @@ newtype From a = From -- as well as supporting backwards compatibility for the -- data constructor join tree used prior to /3.5.0.0/ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 class ToFrom a r | a -> r where toFrom :: a -> From r instance ToFrom (From a) a where toFrom = id -{-# DEPRECATED Table "/Since: 3.5.0.0/ - use 'table' instead" #-} +{-# DEPRECATED Table "@since 3.5.0.0 - use 'table' instead" #-} data Table a = Table instance PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) where @@ -84,7 +82,7 @@ instance PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) where -- select $ from $ table \@People -- @ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 table :: forall ent. PersistEntity ent => From (SqlExpr (Entity ent)) table = From $ do let ed = entityDef (Proxy @ent) @@ -123,7 +121,7 @@ instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlQuery a) a -- ... -- @ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 selectQuery :: (SqlSelect a r, ToAlias a, ToAliasReference a) => SqlQuery a -> From a selectQuery subquery = From $ do -- We want to update the IdentState without writing the query to side data diff --git a/src/Database/Esqueleto/Experimental/From/Join.hs b/src/Database/Esqueleto/Experimental/From/Join.hs index c685adc..ee8c709 100644 --- a/src/Database/Esqueleto/Experimental/From/Join.hs +++ b/src/Database/Esqueleto/Experimental/From/Join.hs @@ -1,37 +1,31 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Esqueleto.Experimental.From.Join where -import Data.Bifunctor (first) -import Data.Kind (Constraint) -import Data.Proxy -import qualified Data.Text.Lazy.Builder as TLB -import Database.Esqueleto.Experimental.From -import Database.Esqueleto.Experimental.From.SqlSetOperation -import Database.Esqueleto.Experimental.ToAlias -import Database.Esqueleto.Experimental.ToAliasReference -import Database.Esqueleto.Experimental.ToMaybe -import Database.Esqueleto.Internal.Internal hiding - (From (..), - from, - fromJoin, - on) -import Database.Esqueleto.Internal.PersistentImport (Entity (..), - EntityField, - PersistEntity, - PersistField) -import GHC.TypeLits +import Data.Bifunctor (first) +import Data.Kind (Constraint) +import Data.Proxy +import qualified Data.Text.Lazy.Builder as TLB +import Database.Esqueleto.Experimental.From +import Database.Esqueleto.Experimental.ToAlias +import Database.Esqueleto.Experimental.ToAliasReference +import Database.Esqueleto.Experimental.ToMaybe +import Database.Esqueleto.Internal.Internal hiding + (From(..), from, fromJoin, on) +import GHC.TypeLits -- | A left-precedence pair. Pronounced \"and\". Used to represent expressions -- that have been joined together. @@ -110,7 +104,7 @@ type family HasOnClause actual expected :: Constraint where -- p ^. PersonId ==. bp ^. BlogPostAuthorId) -- @ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 innerJoin :: ( ToFrom a a' , ToFrom b b' , HasOnClause rhs (a' :& b') @@ -132,7 +126,7 @@ innerJoin lhs (rhs, on') = From $ do -- -- See example 6 -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 innerJoinLateral :: ( ToFrom a a' , HasOnClause rhs (a' :& b) , SqlSelect b r @@ -157,7 +151,7 @@ innerJoinLateral lhs (rhsFn, on') = From $ do -- \`crossJoin\` table \@BlogPost -- @ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 crossJoin :: ( ToFrom a a' , ToFrom b b' ) => a -> b -> From (a' :& b') @@ -176,7 +170,7 @@ crossJoin lhs rhs = From $ do -- -- See example 6 -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 crossJoinLateral :: ( ToFrom a a' , SqlSelect b r , ToAlias b @@ -205,7 +199,7 @@ crossJoinLateral lhs rhsFn = From $ do -- p ^. PersonId ==. bp ?. BlogPostAuthorId) -- @ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 leftJoin :: ( ToFrom a a' , ToFrom b b' , ToMaybe b' @@ -229,7 +223,7 @@ leftJoin lhs (rhs, on') = From $ do -- -- See example 6 for how to use LATERAL -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 leftJoinLateral :: ( ToFrom a a' , SqlSelect b r , HasOnClause rhs (a' :& ToMaybeT b) @@ -261,7 +255,7 @@ leftJoinLateral lhs (rhsFn, on') = From $ do -- p ?. PersonId ==. bp ^. BlogPostAuthorId) -- @ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 rightJoin :: ( ToFrom a a' , ToFrom b b' , ToMaybe a' @@ -289,7 +283,7 @@ rightJoin lhs (rhs, on') = From $ do -- p ?. PersonId ==. bp ?. BlogPostAuthorId) -- @ -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 fullOuterJoin :: ( ToFrom a a' , ToFrom b b' , ToMaybe a' diff --git a/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs b/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs index 943055b..71965be 100644 --- a/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs +++ b/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs @@ -21,15 +21,14 @@ import Database.Esqueleto.Experimental.From import Database.Esqueleto.Experimental.ToAlias import Database.Esqueleto.Experimental.ToAliasReference import Database.Esqueleto.Internal.Internal hiding (From(..), from, on) -import Database.Esqueleto.Internal.PersistentImport - (Entity, PersistEntity, PersistValue) +import Database.Esqueleto.Internal.PersistentImport (PersistValue) -- | Data type used to implement the SqlSetOperation language -- this type is implemented in the same way as a @From@ -- -- Semantically a @SqlSetOperation@ is always a @From@ but not vice versa -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 newtype SqlSetOperation a = SqlSetOperation { unSqlSetOperation :: NeedParens -> SqlQuery (a, IdentInfo -> (TLB.Builder, [PersistValue]))} @@ -42,7 +41,7 @@ instance ToAliasReference a => ToFrom (SqlSetOperation a) a where -- | Type class to support direct use of @SqlQuery@ in a set operation tree -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 class ToSqlSetOperation a r | a -> r where toSqlSetOperation :: a -> SqlSetOperation r instance ToSqlSetOperation (SqlSetOperation a) a where @@ -67,7 +66,7 @@ instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToSqlSetOperation (Sq pure (aliasedValue, \info -> first (parensM p') $ toRawSql SELECT info aliasedQuery) -- | Helper function for defining set operations --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 mkSetOperation :: (ToSqlSetOperation a a', ToSqlSetOperation b a') => TLB.Builder -> a -> b -> SqlSetOperation a' mkSetOperation operation lhs rhs = SqlSetOperation $ \p -> do @@ -83,7 +82,7 @@ instance ToSqlSetOperation a a' => ToSqlSetOperation (Union a a) a' where -- | Overloaded @union_@ function to support use in both 'SqlSetOperation' -- and 'withRecursive' -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 class Union_ a where -- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values. union_ :: a @@ -95,7 +94,7 @@ instance (ToSqlSetOperation a c, ToSqlSetOperation b c, res ~ SqlSetOperation c) -- | Overloaded @unionAll_@ function to support use in both 'SqlSetOperation' -- and 'withRecursive' -- --- /Since: 3.5.0.0/ +-- @since 3.5.0.0 class UnionAll_ a where -- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values. unionAll_ :: a diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 5ee850c..4f2d85f 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -28,7 +28,6 @@ module Database.Esqueleto.Internal.Internal where import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL import Control.Applicative ((<|>)) -import Data.Coerce (Coercible, coerce) import Control.Arrow (first, (***)) import Control.Exception (Exception, throw, throwIO) import Control.Monad (MonadPlus(..), guard, void) @@ -66,12 +65,12 @@ import Database.Persist (FieldNameDB(..), EntityNameDB(..)) import Database.Persist.Sql.Util ( entityColumnCount , keyAndEntityColumnNames - , hasNaturalKey , isIdField , parseEntityValues ) import Text.Blaze.Html (Html) import Data.Coerce (coerce) +import Data.Kind (Type) -- | (Internal) Start a 'from' query with an entity. 'from' -- does two kinds of magic using 'fromStart', 'fromJoin' and @@ -95,7 +94,7 @@ fromStart fromStart = do let ed = entityDef (Proxy :: Proxy a) ident <- newIdentFor (coerce $ getEntityDBName ed) - let ret = unsafeSqlEntity ident + let ret = unsafeSqlEntity ident f' = FromStart ident ed return (PreprocessedFrom ret f') @@ -264,7 +263,7 @@ asc = orderByExpr " ASC" -- | Descending order of this field or SqlExpression. desc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy -desc = orderByExpr " DESC" +desc = orderByExpr " DESC" orderByExpr :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr OrderBy orderByExpr orderByType (ERaw m f) @@ -381,7 +380,7 @@ distinctOnOrderBy exprs act = -- -- @since 1.3.10 rand :: SqlExpr OrderBy -rand = ERaw noMeta $ \_ _ -> ("RANDOM()", []) +rand = ERaw noMeta $ \_ _ -> ("RANDOM()", []) -- | @HAVING@. -- @@ -550,7 +549,7 @@ subSelectUnsafe = sub SELECT ERaw m f ^. field | isIdField field = idFieldValue | Just alias <- sqlExprMetaAlias m = - ERaw noMeta $ \_ info -> + ERaw noMeta $ \_ info -> f Never info <> ("." <> useIdent info (aliasedEntityColumnIdent alias fieldDef), []) | otherwise = ERaw noMeta $ \_ info -> (dot info $ persistFieldDef field, []) where @@ -567,20 +566,20 @@ ERaw m f ^. field idFields -> let renderedFields info = dot info <$> NEL.toList idFields - in ERaw noMeta{ sqlExprMetaCompositeFields = Just renderedFields} $ + in ERaw noMeta{ sqlExprMetaCompositeFields = Just renderedFields} $ \p info -> (parensM p $ uncommas $ renderedFields info, []) ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) - dot info fieldDef = + dot info fieldDef' = sourceIdent info <> "." <> fieldIdent where sourceIdent = fmap fst $ f Never - fieldIdent - | Just baseI <- sqlExprMetaAlias m = - useIdent info $ aliasedEntityColumnIdent baseI fieldDef - | otherwise = - fromDBName info (coerce $ fieldDB fieldDef) + fieldIdent + | Just baseI <- sqlExprMetaAlias m = + useIdent info $ aliasedEntityColumnIdent baseI fieldDef' + | otherwise = + fromDBName info (coerce $ fieldDB fieldDef') -- | Project an SqlExpression that may be null, guarding against null cases. withNonNull @@ -629,13 +628,14 @@ isNothing v = case v of ERaw m f -> case sqlExprMetaCompositeFields m of - Just fields -> + Just fields -> ERaw noMeta $ \p info -> first (parensM p) . flip (,) [] . (intersperseB " AND " . map (<> " IS NULL")) $ fields info Nothing -> ERaw noMeta $ \p info -> first (parensM p) . isNullExpr $ f Never info where + isNullExpr :: (TLB.Builder, a) -> (TLB.Builder, a) isNullExpr = first ((<> " IS NULL")) -- | Analogous to 'Just', promotes a value of type @typ@ into @@ -657,10 +657,10 @@ joinV = veryUnsafeCoerceSqlExprValue countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a) countHelper open close v = case v of - ERaw meta f -> + ERaw meta f -> if hasCompositeKeyMeta meta then countRows - else + else countRawSql (f Never) where countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) @@ -688,7 +688,7 @@ not_ v = ERaw noMeta $ \p info -> first ("NOT " <>) $ x p info ERaw m f -> if hasCompositeKeyMeta m then throw (CompositeKeyErr NotError) - else + else let (b, vals) = f Never info in (parensM p b, vals) @@ -923,22 +923,22 @@ justList (ERaw m f) = ERaw m f -- -- Where @personIds@ is of type @[Key Person]@. in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) -(ERaw _ v) `in_` (ERaw _ list) = - ERaw noMeta $ \p info -> - let (b1, vals1) = v Parens info - (b2, vals2) = list Parens info - in +(ERaw _ v) `in_` (ERaw _ list) = + ERaw noMeta $ \_ info -> + let (b1, vals1) = v Parens info + (b2, vals2) = list Parens info + in if b2 == "()" then ("FALSE", []) - else + else (b1 <> " IN " <> b2, vals1 <> vals2) -- | @NOT IN@ operator. notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) -(ERaw _ v) `notIn` (ERaw _ list) = - ERaw noMeta $ \p info -> - let (b1, vals1) = v Parens info - (b2, vals2) = list Parens info +(ERaw _ v) `notIn` (ERaw _ list) = + ERaw noMeta $ \_ info -> + let (b1, vals1) = v Parens info + (b2, vals2) = list Parens info in (b1 <> " NOT IN " <> b2, vals1 <> vals2) -- | @EXISTS@ operator. For example: @@ -952,15 +952,15 @@ notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> S -- return person -- @ exists :: SqlQuery () -> SqlExpr (Value Bool) -exists q = ERaw noMeta $ \p info -> +exists q = ERaw noMeta $ \p info -> let ERaw _ f = existsHelper q (b, vals) = f Never info in ( parensM p $ "EXISTS " <> b, vals) -- | @NOT EXISTS@ operator. notExists :: SqlQuery () -> SqlExpr (Value Bool) -notExists q = ERaw noMeta $ \p info -> - let ERaw _ f = existsHelper q +notExists q = ERaw noMeta $ \p info -> + let ERaw _ f = existsHelper q (b, vals) = f Never info in ( parensM p $ "NOT EXISTS " <> b, vals) @@ -989,14 +989,14 @@ field /=. expr = setAux field (\ent -> ent ^. field /. expr) -- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments. (<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b) -(<#) _ (ERaw _ f) = ERaw noMeta f +(<#) _ (ERaw _ f) = ERaw noMeta f -- | Apply extra @SqlExpr Value@ arguments to a 'PersistField' constructor (<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b) (ERaw _ f) <&> (ERaw _ g) = ERaw noMeta $ \_ info -> - let (fb, fv) = f Never info - (gb, gv) = g Never info + let (fb, fv) = f Never info + (gb, gv) = g Never info in (fb <> ", " <> gb, fv ++ gv) -- | @CASE@ statement. For example: @@ -1448,7 +1448,7 @@ instance SqlString a => SqlString (Maybe a) where -- key on a query into another (cf. 'toBaseId'). class ToBaseId ent where -- | e.g. @type BaseEnt MyBase = MyChild@ - type BaseEnt ent :: * + type BaseEnt ent :: Type -- | Convert from the key of the BaseEnt(ity) to the key of the child entity. -- This function is not actually called, but that it typechecks proves this operation is safe. toBaseIdWitness :: Key (BaseEnt ent) -> Key ent @@ -2042,43 +2042,43 @@ data SqlExprMeta = SqlExprMeta sqlExprMetaCompositeFields :: Maybe (IdentInfo -> [TLB.Builder]) , sqlExprMetaAlias :: Maybe Ident -- Alias ident if this is an aliased value/entity , sqlExprMetaIsReference :: Bool -- Is this SqlExpr a reference to the selected value/entity (supports subqueries) - } + } -- | Empty 'SqlExprMeta' if you are constructing an 'ERaw' probably use this -- for your meta noMeta :: SqlExprMeta -noMeta = SqlExprMeta +noMeta = SqlExprMeta { sqlExprMetaCompositeFields = Nothing , sqlExprMetaAlias = Nothing , sqlExprMetaIsReference = False } --- | Does this meta contain values for composite fields. +-- | Does this meta contain values for composite fields. -- This field is field out for composite key values hasCompositeKeyMeta :: SqlExprMeta -> Bool -hasCompositeKeyMeta = Maybe.isJust . sqlExprMetaCompositeFields +hasCompositeKeyMeta = Maybe.isJust . sqlExprMetaCompositeFields entityAsValue :: SqlExpr (Entity val) -> SqlExpr (Value (Entity val)) -entityAsValue = coerce +entityAsValue = coerce entityAsValueMaybe :: SqlExpr (Maybe (Entity val)) -> SqlExpr (Value (Maybe (Entity val))) -entityAsValueMaybe = coerce +entityAsValueMaybe = coerce -- | An expression on the SQL backend. -- --- Raw expression: Contains a 'SqlExprMeta' and a function for --- building the expr. It recieves a parameter telling it whether +-- Raw expression: Contains a 'SqlExprMeta' and a function for +-- building the expr. It recieves a parameter telling it whether -- it is in a parenthesized context, and takes information about the SQL -- connection (mainly for escaping names) and returns both an -- string ('TLB.Builder') and a list of values to be -- interpolated by the SQL backend. data SqlExpr a = ERaw SqlExprMeta (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) --- | Data type to support from hack +-- | Data type to support from hack data PreprocessedFrom a = PreprocessedFrom a FromClause -- | Phantom type used to mark a @INSERT INTO@ query. @@ -2131,7 +2131,7 @@ unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] - unsafeSqlCase when v = ERaw noMeta buildCase where buildCase :: NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) - buildCase p info = + buildCase _ info = let (elseText, elseVals) = valueToSql v Parens info (whenText, whenVals) = mapWhen when Parens info in ( "CASE" <> whenText <> " ELSE " <> elseText <> " END", whenVals <> elseVals) @@ -2163,7 +2163,7 @@ unsafeSqlCase when v = ERaw noMeta buildCase -- In the example above, we constraint the arguments to be of the -- same type and constraint the result to be a boolean value. unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) -unsafeSqlBinOp op (ERaw m1 f1) (ERaw m2 f2) +unsafeSqlBinOp op (ERaw m1 f1) (ERaw m2 f2) | not (hasCompositeKeyMeta m1 || hasCompositeKeyMeta m2) = ERaw noMeta f where f p info = @@ -2223,7 +2223,7 @@ unsafeSqlBinOpComposite op sep a b listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue]) listify (ERaw m f) - | Just f <- sqlExprMetaCompositeFields m = flip (,) [] . f + | Just k <- sqlExprMetaCompositeFields m = flip (,) [] . k | otherwise = deconstruct . f Parens deconstruct :: (TLB.Builder, [PersistValue]) -> ([TLB.Builder], [PersistValue]) @@ -2261,7 +2261,7 @@ unsafeSqlFunction :: UnsafeSqlFunctionArgument a => TLB.Builder -> a -> SqlExpr (Value b) unsafeSqlFunction name arg = - ERaw noMeta $ \p info -> + ERaw noMeta $ \_ info -> let (argsTLB, argsVals) = uncommas' $ map (valueToFunctionArg info) $ toArgList arg in @@ -2287,7 +2287,7 @@ unsafeSqlFunctionParens :: UnsafeSqlFunctionArgument a => TLB.Builder -> a -> SqlExpr (Value b) unsafeSqlFunctionParens name arg = - ERaw noMeta $ \p info -> + ERaw noMeta $ \_ info -> let valueToFunctionArgParens (ERaw _ f) = f Never info (argsTLB, argsVals) = uncommas' $ map valueToFunctionArgParens $ toArgList arg @@ -2433,7 +2433,7 @@ veryUnsafeCoerceSqlExprValue = coerce -- | (Internal) Coerce a value's type from 'SqlExpr (ValueList -- a)' to 'SqlExpr (Value a)'. Does not work with empty lists. veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a) -veryUnsafeCoerceSqlExprValueList = coerce +veryUnsafeCoerceSqlExprValueList = coerce ---------------------------------------------------------------------- @@ -2585,14 +2585,14 @@ delete :: (MonadIO m) => SqlQuery () -> SqlWriteT m () -delete = void . deleteCount +delete a = void $ deleteCount a -- | Same as 'delete', but returns the number of rows affected. deleteCount :: (MonadIO m) => SqlQuery () -> SqlWriteT m Int64 -deleteCount = rawEsqueleto DELETE +deleteCount a = rawEsqueleto DELETE a -- | Execute an @esqueleto@ @UPDATE@ query inside @persistent@'s -- 'SqlPersistT' monad. Note that currently there are no type @@ -2613,7 +2613,7 @@ update ) => (SqlExpr (Entity val) -> SqlQuery ()) -> SqlWriteT m () -update = void . updateCount +update a = void $ updateCount a -- | Same as 'update', but returns the number of rows affected. updateCount @@ -2623,11 +2623,12 @@ updateCount ) => (SqlExpr (Entity val) -> SqlQuery ()) -> SqlWriteT m Int64 -updateCount = rawEsqueleto UPDATE . from +updateCount a = rawEsqueleto UPDATE $ from a builderToText :: TLB.Builder -> T.Text builderToText = TL.toStrict . TLB.toLazyTextWith defaultChunkSize where + defaultChunkSize :: Int defaultChunkSize = 1024 - 32 -- | (Internal) Pretty prints a 'SqlQuery' into a SQL query. @@ -2669,7 +2670,7 @@ toRawSql mode (conn, firstIdentState) query = , makeGroupBy info groupByClause , makeHaving info havingClause , makeOrderBy info orderByClauses - , makeLimit info limitClause orderByClauses + , makeLimit info limitClause , makeLocking lockingClause ] @@ -2890,18 +2891,16 @@ makeOrderByNoNewline info os = first ("ORDER BY " <>) . uncommas' $ concatMap mk mk :: OrderByClause -> [(TLB.Builder, [PersistValue])] mk (ERaw _ f) = [f Never info] - orderByType ASC = " ASC" - orderByType DESC = " DESC" - makeOrderBy :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue]) makeOrderBy _ [] = mempty makeOrderBy info is = let (tlb, vals) = makeOrderByNoNewline info is in ("\n" <> tlb, vals) -makeLimit :: IdentInfo -> LimitClause -> [OrderByClause] -> (TLB.Builder, [PersistValue]) -makeLimit (conn, _) (Limit ml mo) orderByClauses = +makeLimit :: IdentInfo -> LimitClause -> (TLB.Builder, [PersistValue]) +makeLimit (conn, _) (Limit ml mo) = let limitRaw = getConnLimitOffset (v ml, v mo) "\n" conn + v :: Maybe Int64 -> Int v = maybe 0 fromIntegral in (TLB.fromText limitRaw, mempty) @@ -2989,27 +2988,27 @@ unescapedColumnNames ent = -- | You may return an 'Entity' from a 'select' query. instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where - sqlSelectCols info expr@(ERaw m f) - | Just baseIdent <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m = - let process ed = uncommas $ + sqlSelectCols info expr@(ERaw m f) + | Just baseIdent <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m = + let process = uncommas $ map ((name <>) . aliasName) $ unescapedColumnNames ed aliasName columnName = (fromDBName info columnName) <> " AS " <> aliasedColumnName baseIdent info (unDBName columnName) name = fst (f Never info) <> "." ed = entityDef $ getEntityVal $ return expr - in (process ed, mempty) - | Just baseIdent <- sqlExprMetaAlias m, True <- sqlExprMetaIsReference m = - let process ed = uncommas $ + in (process, mempty) + | Just baseIdent <- sqlExprMetaAlias m, True <- sqlExprMetaIsReference m = + let process = uncommas $ map ((name <>) . aliasedColumnName baseIdent info . unDBName) $ unescapedColumnNames ed name = fst (f Never info) <> "." ed = entityDef $ getEntityVal $ return expr - in (process ed, mempty) + in (process, mempty) | otherwise = - let process ed = - uncommas - $ map ((name <>) . TLB.fromText) - $ NEL.toList + let process = + uncommas + $ map ((name <>) . TLB.fromText) + $ NEL.toList $ keyAndEntityColumnNames ed (fst info) -- 'name' is the biggest difference between 'RawSql' and -- 'SqlSelect'. We automatically create names for tables @@ -3019,7 +3018,7 @@ instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where -- example). name = fst (f Never info) <> "." ed = entityDef $ getEntityVal $ return expr - in (process ed, mempty) + in (process, mempty) sqlSelectColCount = entityColumnCount . entityDef . getEntityVal sqlSelectProcessRow = parseEntityValues ed @@ -3031,7 +3030,7 @@ getEntityVal = const Proxy -- | You may return a possibly-@NULL@ 'Entity' from a 'select' query. instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where - sqlSelectCols info e = sqlSelectCols info (coerce e :: SqlExpr (Entity a)) + sqlSelectCols info e = sqlSelectCols info (coerce e :: SqlExpr (Entity a)) sqlSelectColCount = sqlSelectColCount . fromEMaybe where fromEMaybe :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e) @@ -3564,14 +3563,14 @@ insertSelect :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m () -insertSelect = void . insertSelectCount +insertSelect a = void $ insertSelectCount a -- | Insert a 'PersistField' for every selected value, return the count afterward insertSelectCount :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m Int64 -insertSelectCount = rawEsqueleto INSERT_INTO +insertSelectCount a = rawEsqueleto INSERT_INTO a -- | Renders an expression into 'Text'. Only useful for creating a textual -- representation of the clauses passed to an "On" clause. diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs deleted file mode 100644 index 382cba3..0000000 --- a/src/Database/Esqueleto/Internal/Language.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - --- | This is an internal module, anything exported by this module --- may change without a major version bump. Please use only --- "Database.Esqueleto" if possible. --- --- This module is deprecated as of 3.4.0.1, and will be removed in 3.5.0.0. -module Database.Esqueleto.Internal.Language - {-# DEPRECATED "Use Database.Esqueleto.Internal.Internal instead. This module will be removed in 3.5.0.0 " #-} - ( -- * The pretty face - from - , Value(..) - , ValueList(..) - , SomeValue(..) - , ToSomeValues(..) - , InnerJoin(..) - , CrossJoin(..) - , LeftOuterJoin(..) - , RightOuterJoin(..) - , FullOuterJoin(..) - , OnClauseWithoutMatchingJoinException(..) - , OrderBy - , DistinctOn - , Update - , Insertion - , LockingKind(..) - , SqlString - , ToBaseId(..) - -- * The guts - , JoinKind(..) - , IsJoinKind(..) - , BackendCompatible(..) - , PreprocessedFrom - , From - , FromPreprocess - , when_ - , then_ - , else_ - , where_ - , on - , groupBy - , orderBy - , rand - , asc - , desc - , limit - , offset - , distinct - , distinctOn - , don - , distinctOnOrderBy - , having - , locking - , sub_select - , (^.) - , (?.) - , val - , isNothing - , just - , nothing - , joinV - , withNonNull - , countRows - , count - , countDistinct - , not_ - , (==.) - , (>=.) - , (>.) - , (<=.) - , (<.) - , (!=.) - , (&&.) - , (||.) - , between - , (+.) - , (-.) - , (/.) - , (*.) - , random_ - , round_ - , ceiling_ - , floor_ - , min_ - , max_ - , sum_ - , avg_ - , castNum - , castNumM - , coalesce - , coalesceDefault - , lower_ - , upper_ - , trim_ - , ltrim_ - , rtrim_ - , length_ - , left_ - , right_ - , like - , ilike - , (%) - , concat_ - , (++.) - , castString - , subList_select - , valList - , justList - , in_ - , notIn - , exists - , notExists - , set - , (=.) - , (+=.) - , (-=.) - , (*=.) - , (/=.) - , case_ - , toBaseId - , (<#) - , (<&>) - , subSelect - , subSelectMaybe - , subSelectCount - , subSelectList - , subSelectForeign - , subSelectUnsafe - ) where - -import Database.Esqueleto.Internal.Internal -import Database.Esqueleto.Internal.PersistentImport diff --git a/src/Database/Esqueleto/Internal/PersistentImport.hs b/src/Database/Esqueleto/Internal/PersistentImport.hs index d3c0d44..5f3d812 100644 --- a/src/Database/Esqueleto/Internal/PersistentImport.hs +++ b/src/Database/Esqueleto/Internal/PersistentImport.hs @@ -138,7 +138,6 @@ module Database.Esqueleto.Internal.PersistentImport , getEntityId , getEntityDBName , getEntityUniques - , getEntityDBName ) where import Database.Persist.Sql hiding diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs deleted file mode 100644 index 2af0009..0000000 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - - --- | This is an internal module, anything exported by this module --- may change without a major version bump. Please use only --- "Database.Esqueleto" if possible. --- --- This module is deprecated as of 3.4.0.1, and will be removed in 3.5.0.0. -module Database.Esqueleto.Internal.Sql - {-# DEPRECATED "Use Database.Esqueleto.Internal.Internal instead. This module will be removed in 3.5.0.0 " #-} - ( -- * The pretty face - SqlQuery - , SqlExpr(..) - , SqlEntity - , select - , selectSource - , delete - , deleteCount - , update - , updateCount - , insertSelect - , insertSelectCount - -- * The guts - , unsafeSqlCase - , unsafeSqlBinOp - , unsafeSqlValue - , unsafeSqlEntity - , unsafeSqlCastAs - , unsafeSqlFunction - , unsafeSqlExtractSubField - , UnsafeSqlFunctionArgument - , OrderByClause - , rawSelectSource - , runSource - , rawEsqueleto - , toRawSql - , Mode(..) - , NeedParens(..) - , IdentState - , renderExpr - , initialIdentState - , IdentInfo - , SqlSelect(..) - , veryUnsafeCoerceSqlExprValue - , veryUnsafeCoerceSqlExprValueList - -- * Helper functions - , renderQueryToText - , renderQuerySelect - , renderQueryUpdate - , renderQueryDelete - , renderQueryInsertInto - , makeOrderByNoNewline - , uncommas' - , parens - , toArgList - , builderToText - , Ident(..) - , valkey - , valJ - , deleteKey - , associateJoin - ) where - -import Database.Esqueleto.Internal.Internal diff --git a/src/Database/Esqueleto/Legacy.hs b/src/Database/Esqueleto/Legacy.hs new file mode 100644 index 0000000..6acead6 --- /dev/null +++ b/src/Database/Esqueleto/Legacy.hs @@ -0,0 +1,415 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} + +-- | WARNING +-- +-- This module is introduced in version @3.5.0.0@ to provide a smooth migration +-- experience from this legacy syntax to the new and improved syntax. If you've +-- imported this module, it means you've decided to use the old syntax for +-- a little bit longer, rather than migrate to the new stuff. That's fine! +-- +-- But you should know that this module, and all of the legacy syntax, will be +-- completely removed from the library in version @4.0.0.0@. +-- +-- The @esqueleto@ EDSL (embedded domain specific language). +-- This module replaces @Database.Persist@, so instead of +-- importing that module you should just import this one: +-- +-- @ +-- -- For a module using just esqueleto. +-- import Database.Esqueleto +-- @ +-- +-- If you need to use @persistent@'s default support for queries +-- as well, either import it qualified: +-- +-- @ +-- -- For a module that mostly uses esqueleto. +-- import Database.Esqueleto +-- import qualified Database.Persist as P +-- @ +-- +-- or import @esqueleto@ itself qualified: +-- +-- @ +-- -- For a module that uses esqueleto just on some queries. +-- import Database.Persist +-- import qualified Database.Esqueleto as E +-- @ +-- +-- Other than identifier name clashes, @esqueleto@ does not +-- conflict with @persistent@ in any way. +module Database.Esqueleto.Legacy + ( -- * Setup + -- $setup + + -- * Introduction + -- $introduction + + -- * Getting started + -- $gettingstarted + + -- * @esqueleto@'s Language + where_, on, groupBy, orderBy, rand, asc, desc, limit, offset + , distinct, distinctOn, don, distinctOnOrderBy, having, locking + , sub_select, (^.), (?.) + , val, isNothing, just, nothing, joinV, withNonNull + , countRows, count, countDistinct + , not_, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) + , between, (+.), (-.), (/.), (*.) + , random_, round_, ceiling_, floor_ + , min_, max_, sum_, avg_, castNum, castNumM + , coalesce, coalesceDefault + , lower_, upper_, trim_, ltrim_, rtrim_, length_, left_, right_ + , like, ilike, (%), concat_, (++.), castString + , subList_select, valList, justList + , in_, notIn, exists, notExists + , set, (=.), (+=.), (-=.), (*=.), (/=.) + , case_, toBaseId + , subSelect + , subSelectMaybe + , subSelectCount + , subSelectForeign + , subSelectList + , subSelectUnsafe + , ToBaseId(..) + , when_ + , then_ + , else_ + , from + , Value(..) + , ValueList(..) + , OrderBy + , DistinctOn + , LockingKind(..) + , SqlString + -- ** Joins + , InnerJoin(..) + , CrossJoin(..) + , LeftOuterJoin(..) + , RightOuterJoin(..) + , FullOuterJoin(..) + , JoinKind(..) + , OnClauseWithoutMatchingJoinException(..) + -- * SQL backend + , SqlQuery + , SqlExpr + , SqlEntity + , select + , selectSource + , delete + , deleteCount + , update + , updateCount + , insertSelect + , insertSelectCount + , (<#) + , (<&>) + -- ** Rendering Queries + , renderQueryToText + , renderQuerySelect + , renderQueryUpdate + , renderQueryDelete + , renderQueryInsertInto + -- * Internal.Language + , From + -- * RDBMS-specific modules + -- $rdbmsSpecificModules + + -- * Helpers + , valkey + , valJ + , associateJoin + + -- * Re-exports + -- $reexports + , deleteKey + , module Database.Esqueleto.Internal.PersistentImport + ) where + +import Database.Esqueleto.Internal.Internal +import Database.Esqueleto.Internal.PersistentImport + + +-- $setup +-- +-- If you're already using @persistent@, then you're ready to use +-- @esqueleto@, no further setup is needed. If you're just +-- starting a new project and would like to use @esqueleto@, take +-- a look at @persistent@'s book first +-- () to learn how to +-- define your schema. + + +---------------------------------------------------------------------- + + +-- $introduction +-- +-- The main goals of @esqueleto@ are to: +-- +-- * Be easily translatable to SQL. When you take a look at a +-- @esqueleto@ query, you should be able to know exactly how +-- the SQL query will end up. (As opposed to being a +-- relational algebra EDSL such as HaskellDB, which is +-- non-trivial to translate into SQL.) +-- +-- * Support the most widely used SQL features. We'd like you to be +-- able to use @esqueleto@ for all of your queries, no +-- exceptions. Send a pull request or open an issue on our +-- project page () if +-- there's anything missing that you'd like to see. +-- +-- * Be as type-safe as possible. We strive to provide as many +-- type checks as possible. If you get bitten by some invalid +-- code that type-checks, please open an issue on our project +-- page so we can take a look. +-- +-- However, it is /not/ a goal to be able to write portable SQL. +-- We do not try to hide the differences between DBMSs from you, +-- and @esqueleto@ code that works for one database may not work +-- on another. This is a compromise we have to make in order to +-- give you as much control over the raw SQL as possible without +-- losing too much convenience. This also means that you may +-- type-check a query that doesn't work on your DBMS. + + +---------------------------------------------------------------------- + + +-- $gettingstarted +-- +-- We like clean, easy-to-read EDSLs. However, in order to +-- achieve this goal we've used a lot of type hackery, leading to +-- some hard-to-read type signatures. On this section, we'll try +-- to build some intuition about the syntax. +-- +-- For the following examples, we'll use this example schema: +-- +-- @ +-- share [mkPersist sqlSettings, mkMigrate \"migrateAll\"] [persist| +-- Person +-- name String +-- age Int Maybe +-- deriving Eq Show +-- BlogPost +-- title String +-- authorId PersonId +-- deriving Eq Show +-- Follow +-- follower PersonId +-- followed PersonId +-- deriving Eq Show +-- |] +-- @ +-- +-- Most of @esqueleto@ was created with @SELECT@ statements in +-- mind, not only because they're the most common but also +-- because they're the most complex kind of statement. The most +-- simple kind of @SELECT@ would be: +-- +-- @ +-- SELECT * +-- FROM Person +-- @ +-- +-- In @esqueleto@, we may write the same query above as: +-- +-- @ +-- do people <- 'select' $ +-- 'from' $ \\person -> do +-- return person +-- liftIO $ mapM_ (putStrLn . personName . entityVal) people +-- @ +-- +-- The expression above has type @SqlPersist m ()@, while +-- @people@ has type @[Entity Person]@. The query above will be +-- translated into exactly the same query we wrote manually, but +-- instead of @SELECT *@ it will list all entity fields (using +-- @*@ is not robust). Note that @esqueleto@ knows that we want +-- an @Entity Person@ just because of the @personName@ that we're +-- printing later. +-- +-- However, most of the time we need to filter our queries using +-- @WHERE@. For example: +-- +-- @ +-- SELECT * +-- FROM Person +-- WHERE Person.name = \"John\" +-- @ +-- +-- In @esqueleto@, we may write the same query above as: +-- +-- @ +-- 'select' $ +-- 'from' $ \\p -> do +-- 'where_' (p '^.' PersonName '==.' 'val' \"John\") +-- return p +-- @ +-- +-- Although @esqueleto@'s code is a bit more noisy, it's has +-- almost the same structure (save from the @return@). The +-- @('^.')@ operator is used to project a field from an entity. +-- The field name is the same one generated by @persistent@'s +-- Template Haskell functions. We use 'val' to lift a constant +-- Haskell value into the SQL query. +-- +-- Another example would be: +-- +-- @ +-- SELECT * +-- FROM Person +-- WHERE Person.age >= 18 +-- @ +-- +-- In @esqueleto@, we may write the same query above as: +-- +-- @ +-- 'select' $ +-- 'from' $ \\p -> do +-- 'where_' (p '^.' PersonAge '>=.' 'just' ('val' 18)) +-- return p +-- @ +-- +-- Since @age@ is an optional @Person@ field, we use 'just' to lift +-- @'val' 18 :: SqlExpr (Value Int)@ into @just ('val' 18) :: +-- SqlExpr (Value (Maybe Int))@. +-- +-- Implicit joins are represented by tuples. For example, to get +-- the list of all blog posts and their authors, we could write: +-- +-- @ +-- SELECT BlogPost.*, Person.* +-- FROM BlogPost, Person +-- WHERE BlogPost.authorId = Person.id +-- ORDER BY BlogPost.title ASC +-- @ +-- +-- In @esqueleto@, we may write the same query above as: +-- +-- @ +-- 'select' $ +-- 'from' $ \\(b, p) -> do +-- 'where_' (b '^.' BlogPostAuthorId '==.' p '^.' PersonId) +-- 'orderBy' ['asc' (b '^.' BlogPostTitle)] +-- return (b, p) +-- @ +-- +-- However, you may want your results to include people who don't +-- have any blog posts as well using a @LEFT OUTER JOIN@: +-- +-- @ +-- SELECT Person.*, BlogPost.* +-- FROM Person LEFT OUTER JOIN BlogPost +-- ON Person.id = BlogPost.authorId +-- ORDER BY Person.name ASC, BlogPost.title ASC +-- @ +-- +-- In @esqueleto@, we may write the same query above as: +-- +-- @ +-- 'select' $ +-- 'from' $ \\(p `'LeftOuterJoin`` mb) -> do +-- 'on' ('just' (p '^.' PersonId) '==.' mb '?.' BlogPostAuthorId) +-- 'orderBy' ['asc' (p '^.' PersonName), 'asc' (mb '?.' BlogPostTitle)] +-- return (p, mb) +-- @ +-- +-- On a @LEFT OUTER JOIN@ the entity on the right hand side may +-- not exist (i.e. there may be a @Person@ without any +-- @BlogPost@s), so while @p :: SqlExpr (Entity Person)@, we have +-- @mb :: SqlExpr (Maybe (Entity BlogPost))@. The whole +-- expression above has type @SqlPersist m [(Entity Person, Maybe +-- (Entity BlogPost))]@. Instead of using @(^.)@, we used +-- @('?.')@ to project a field from a @Maybe (Entity a)@. +-- +-- We are by no means limited to joins of two tables, nor by +-- joins of different tables. For example, we may want a list +-- of the @Follow@ entity: +-- +-- @ +-- SELECT P1.*, Follow.*, P2.* +-- FROM Person AS P1 +-- INNER JOIN Follow ON P1.id = Follow.follower +-- INNER JOIN Person AS P2 ON P2.id = Follow.followed +-- @ +-- +-- In @esqueleto@, we may write the same query above as: +-- +-- @ +-- 'select' $ +-- 'from' $ \\(p1 `'InnerJoin`` f `'InnerJoin`` p2) -> do +-- 'on' (p1 '^.' PersonId '==.' f '^.' FollowFollower) +-- 'on' (p2 '^.' PersonId '==.' f '^.' FollowFollowed) +-- return (p1, f, p2) +-- @ +-- +-- We also currently support @UPDATE@ and @DELETE@ statements. +-- For example: +-- +-- @ +-- do 'update' $ \\p -> do +-- 'set' p [ PersonName '=.' 'val' \"João\" ] +-- 'where_' (p '^.' PersonName '==.' 'val' \"Joao\") +-- 'delete' $ +-- 'from' $ \\p -> do +-- 'where_' (p '^.' PersonAge '<.' 'just' ('val' 14)) +-- @ +-- +-- The results of queries can also be used for insertions. +-- In @SQL@, we might write the following, inserting a new blog +-- post for every user: +-- +-- @ +-- INSERT INTO BlogPost +-- SELECT ('Group Blog Post', id) +-- FROM Person +-- @ +-- +-- In @esqueleto@, we may write the same query above as: +-- +-- @ +-- 'insertSelect' $ 'from' $ \\p-> +-- return $ BlogPost '<#' \"Group Blog Post\" '<&>' (p '^.' PersonId) +-- @ +-- +-- Individual insertions can be performed through Persistent's +-- 'insert' function, reexported for convenience. + + +---------------------------------------------------------------------- + + +-- $reexports +-- +-- We re-export many symbols from @persistent@ for convenince: +-- +-- * \"Store functions\" from "Database.Persist". +-- +-- * Everything from "Database.Persist.Class" except for +-- @PersistQuery@ and @delete@ (use 'deleteKey' instead). +-- +-- * Everything from "Database.Persist.Types" except for +-- @Update@, @SelectOpt@, @BackendSpecificFilter@ and @Filter@. +-- +-- * Everything from "Database.Persist.Sql" except for +-- @deleteWhereCount@ and @updateWhereCount@. + + +---------------------------------------------------------------------- + + +-- $rdbmsSpecificModules +-- +-- There are many differences between SQL syntax and functions +-- supported by different RDBMSs. Since version 2.2.8, +-- @esqueleto@ includes modules containing functions that are +-- specific to a given RDBMS. +-- +-- * PostgreSQL: "Database.Esqueleto.PostgreSQL". +-- +-- In order to use these functions, you need to explicitly import +-- their corresponding modules, they're not re-exported here. diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs index ffecb3c..f3d12d6 100644 --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/src/Database/Esqueleto/PostgreSQL.hs @@ -33,14 +33,12 @@ module Database.Esqueleto.PostgreSQL #if __GLASGOW_HASKELL__ < 804 import Data.Semigroup #endif -import Control.Arrow (first, (***)) +import Control.Arrow (first) import Control.Exception (throw) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(..)) import qualified Control.Monad.Trans.Reader as R import Data.Int (Int64) -import Data.List.NonEmpty (NonEmpty((:|))) -import qualified Data.List.NonEmpty as NonEmpty import Data.Proxy (Proxy(..)) import qualified Data.Text.Internal.Builder as TLB import Data.Time.Clock (UTCTime) @@ -283,8 +281,8 @@ insertSelectWithConflict -- violated. The expression takes the current and excluded value to produce -- the updates. -> SqlWriteT m () -insertSelectWithConflict unique query = - void . insertSelectWithConflictCount unique query +insertSelectWithConflict unique query a = + void $ insertSelectWithConflictCount unique query a -- | Same as 'insertSelectWithConflict' but returns the number of rows affected. -- diff --git a/src/Database/Esqueleto/PostgreSQL/JSON.hs b/src/Database/Esqueleto/PostgreSQL/JSON.hs index a105ff8..7ae5a7a 100644 --- a/src/Database/Esqueleto/PostgreSQL/JSON.hs +++ b/src/Database/Esqueleto/PostgreSQL/JSON.hs @@ -136,9 +136,8 @@ module Database.Esqueleto.PostgreSQL.JSON ) where import Data.Text (Text) -import Database.Esqueleto.Internal.Language hiding ((-.), (?.), (||.)) +import Database.Esqueleto.Internal.Internal hiding ((-.), (?.), (||.)) import Database.Esqueleto.Internal.PersistentImport -import Database.Esqueleto.Internal.Sql import Database.Esqueleto.PostgreSQL.JSON.Instances infixl 6 ->., ->>., #>., #>>. diff --git a/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs b/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs index 73d9585..8ec123d 100644 --- a/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs +++ b/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs @@ -15,9 +15,8 @@ import Data.String (IsString(..)) import Data.Text (Text) import qualified Data.Text as T (concat, pack) import qualified Data.Text.Encoding as TE (decodeUtf8, encodeUtf8) -import Database.Esqueleto (Value, just, val) import Database.Esqueleto.Internal.PersistentImport -import Database.Esqueleto.Internal.Sql (SqlExpr) +import Database.Esqueleto.Internal.Internal (SqlExpr, Value, just, val) import GHC.Generics (Generic) -- | Newtype wrapper around any type with a JSON representation. diff --git a/test/Common/Test.hs b/test/Common/Test.hs index 598a7ca..a692e20 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -93,7 +93,7 @@ import qualified Data.Text as Text import qualified Data.Text.Internal.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import qualified Database.Esqueleto.Internal.ExprParser as P -import qualified Database.Esqueleto.Internal.Sql as EI +import qualified Database.Esqueleto.Internal.Internal as EI import qualified UnliftIO.Resource as R -- Test schema @@ -769,7 +769,7 @@ testSelectJoin run = do insert_ $ Frontcover number "" articleId <- insert $ Article "title" number articleMetaE <- insert' (ArticleMetadata articleId) - result <- select . from $ \articleMetadata -> do + result <- select $ from $ \articleMetadata -> do where_ $ (articleMetadata ^. ArticleMetadataId) ==. (val ((ArticleMetadataKey articleId))) pure articleMetadata liftIO $ [articleMetaE] `shouldBe` result @@ -863,7 +863,7 @@ testSelectJoin run = do it "respects the associativity of joins" $ run $ do void $ insert p1 - ps <- select . from $ + ps <- select $ from $ \((p :: SqlExpr (Entity Person)) `LeftOuterJoin` ((_q :: SqlExpr (Entity Person)) @@ -1321,7 +1321,7 @@ testSelectDistinct run = do liftIO $ ret `shouldBe` [ Value t1, Value t2, Value t3 ] it "works on a simple example (select . distinct)" $ - selDistTest (select . distinct) + selDistTest (\a -> select $ distinct a) it "works on a simple example (distinct (return ()))" $ selDistTest (\act -> select $ distinct (return ()) >> act) diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index d36ebf8..c991705 100644 --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -35,7 +35,7 @@ import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) import Database.Esqueleto hiding (random_) import Database.Esqueleto.Experimental hiding (from, on, random_) import qualified Database.Esqueleto.Experimental as Experimental -import qualified Database.Esqueleto.Internal.Sql as ES +import qualified Database.Esqueleto.Internal.Internal as ES import Database.Esqueleto.PostgreSQL (random_) import qualified Database.Esqueleto.PostgreSQL as EP import Database.Esqueleto.PostgreSQL.JSON hiding ((-.), (?.), (||.)) @@ -272,7 +272,7 @@ testArrayAggWith = do let people = [p1, p2, p3, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return (EP.arrayAggWith EP.AggModeAll (p ^. PersonName) []) liftIO $ L.sort ret `shouldBe` L.sort (map personName people) @@ -289,7 +289,7 @@ testArrayAggWith = do let people = [p1, p2, p3, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge) []) liftIO $ L.sort ret `shouldBe` [Nothing, Just 17, Just 36] @@ -310,7 +310,7 @@ testArrayAggWith = do let people = [p1, p2, p3, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return (EP.arrayAggWith EP.AggModeAll (p ^. PersonName) []) liftIO $ L.sort ret `shouldBe` L.sort (map personName people) @@ -329,7 +329,7 @@ testArrayAggWith = do let people = [p1, p2, p3, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge) [asc $ p ^. PersonAge]) liftIO $ ret `shouldBe` [Just 17, Just 36, Nothing] @@ -354,13 +354,13 @@ testStringAggWith = do let people = [p1, p2, p3, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")[]) liftIO $ (L.sort $ words ret) `shouldBe` L.sort (map personName people) it "works with zero rows" $ run $ do [Value ret] <- - select . from $ \p -> + select $ from $ \p -> return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")[]) liftIO $ ret `shouldBe` Nothing @@ -378,7 +378,7 @@ testStringAggWith = do let people = [p1, p2, p3 {personName = "John"}, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName) (val " ") [] liftIO $ (L.sort $ words ret) `shouldBe` @@ -401,7 +401,7 @@ testStringAggWith = do let people = [p1, p2, p3, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return $ EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ") [desc $ p ^. PersonName] liftIO $ (words ret) @@ -422,7 +422,7 @@ testStringAggWith = do let people = [p1, p2, p3 {personName = "John"}, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> + select $ from $ \p -> return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName) (val " ") [desc $ p ^. PersonName] liftIO $ (words ret) `shouldBe` @@ -439,12 +439,12 @@ testAggregateFunctions = do let people = [p1, p2, p3, p4, p5] mapM_ insert people [Value (Just ret)] <- - select . from $ \p -> return (EP.arrayAgg (p ^. PersonName)) + select $ from $ \p -> return (EP.arrayAgg (p ^. PersonName)) liftIO $ L.sort ret `shouldBe` L.sort (map personName people) it "works on zero rows" $ run $ do [Value ret] <- - select . from $ \p -> return (EP.arrayAgg (p ^. PersonName)) + select $ from $ \p -> return (EP.arrayAgg (p ^. PersonName)) liftIO $ ret `shouldBe` Nothing describe "arrayAggWith" testArrayAggWith describe "stringAgg" $ do @@ -459,7 +459,7 @@ testAggregateFunctions = do liftIO $ L.sort (words ret) `shouldBe` L.sort (map personName people) it "works on zero rows" $ run $ do [Value ret] <- - select . from $ \p -> return (EP.stringAgg (p ^. PersonName) (val " ")) + select $ from $ \p -> return (EP.stringAgg (p ^. PersonName) (val " ")) liftIO $ ret `shouldBe` Nothing describe "stringAggWith" testStringAggWith @@ -471,7 +471,7 @@ testAggregateFunctions = do , Person "4" (Just 8) Nothing 2 , Person "5" (Just 9) Nothing 2 ] - ret <- select . from $ \(person :: SqlExpr (Entity Person)) -> do + ret <- select $ from $ \(person :: SqlExpr (Entity Person)) -> do groupBy (person ^. PersonFavNum) return . EP.arrayRemoveNull . EP.maybeArray . EP.arrayAgg $ person ^. PersonAge @@ -481,7 +481,7 @@ testAggregateFunctions = do describe "maybeArray" $ do it "Coalesces NULL into an empty array" $ run $ do [Value ret] <- - select . from $ \p -> + select $ from $ \p -> return (EP.maybeArray $ EP.arrayAgg (p ^. PersonName)) liftIO $ ret `shouldBe` [] @@ -1134,19 +1134,22 @@ testFilterWhere = -- 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) - ) + usersByAge <- fmap coerce <$> do + select $ from $ \users -> do + groupBy $ users ^. PersonAge + return + ( users ^. PersonAge :: SqlExpr (Value (Maybe Int)) + -- 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) + :: SqlExpr (Value Int) + -- 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) + :: SqlExpr (Value Int) + ) liftIO $ usersByAge `shouldMatchList` ( [ (Nothing, 2, 0) @@ -1167,19 +1170,20 @@ testFilterWhere = -- 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) - ) + usersByAge <- fmap (\(Value a, Value b, Value c) -> (a, b, c)) <$> do + 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) @@ -1197,7 +1201,7 @@ testCommonTableExpressions = do void $ select $ do limitedLordsCte <- Experimental.with $ do - lords <- Experimental.from $ Experimental.Table @Lord + lords <- Experimental.from $ Experimental.table @Lord limit 10 pure lords lords <- Experimental.from limitedLordsCte @@ -1260,9 +1264,9 @@ testLateralQuery = do _ <- run $ do select $ do l :& c <- - Experimental.from $ Table @Lord + Experimental.from $ table @Lord `CrossJoin` \lord -> do - deed <- Experimental.from $ Table @Deed + deed <- Experimental.from $ table @Deed where_ $ lord ^. LordId ==. deed ^. DeedOwnerId pure $ countRows @Int pure (l, c) @@ -1271,11 +1275,11 @@ testLateralQuery = do it "supports INNER JOIN LATERAL" $ do run $ do let subquery lord = do - deed <- Experimental.from $ Table @Deed + deed <- Experimental.from $ table @Deed where_ $ lord ^. LordId ==. deed ^. DeedOwnerId pure $ countRows @Int res <- select $ do - l :& c <- Experimental.from $ Table @Lord + l :& c <- Experimental.from $ table @Lord `InnerJoin` subquery `Experimental.on` (const $ val True) pure (l, c) @@ -1287,9 +1291,9 @@ testLateralQuery = do it "supports LEFT JOIN LATERAL" $ do run $ do res <- select $ do - l :& c <- Experimental.from $ Table @Lord + l :& c <- Experimental.from $ table @Lord `LeftOuterJoin` (\lord -> do - deed <- Experimental.from $ Table @Deed + deed <- Experimental.from $ table @Deed where_ $ lord ^. LordId ==. deed ^. DeedOwnerId pure $ countRows @Int) `Experimental.on` (const $ val True) @@ -1303,9 +1307,9 @@ testLateralQuery = do it "compile error on RIGHT JOIN LATERAL" $ do run $ do res <- select $ do - l :& c <- Experimental.from $ Table @Lord + l :& c <- Experimental.from $ table @Lord `RightOuterJoin` (\lord -> do - deed <- Experimental.from $ Table @Deed + deed <- Experimental.from $ table @Deed where_ $ lord ?. LordId ==. just (deed ^. DeedOwnerId) pure $ countRows @Int) `Experimental.on` (const $ val True) @@ -1316,9 +1320,9 @@ testLateralQuery = do it "compile error on FULL OUTER JOIN LATERAL" $ do run $ do res <- select $ do - l :& c <- Experimental.from $ Table @Lord + l :& c <- Experimental.from $ table @Lord `FullOuterJoin` (\lord -> do - deed <- Experimental.from $ Table @Deed + deed <- Experimental.from $ table @Deed where_ $ lord ?. LordId ==. just (deed ^. DeedOwnerId) pure $ countRows @Int) `Experimental.on` (const $ val True)