From 9be40e257f781478334f070763aef0e59eabbb28 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 8 Jan 2025 09:13:54 -0700 Subject: [PATCH 1/8] Re-export Nullable from ToMaybe --- src/Database/Esqueleto/Experimental/ToMaybe.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Database/Esqueleto/Experimental/ToMaybe.hs b/src/Database/Esqueleto/Experimental/ToMaybe.hs index 0677bfb9c..2960024cc 100644 --- a/src/Database/Esqueleto/Experimental/ToMaybe.hs +++ b/src/Database/Esqueleto/Experimental/ToMaybe.hs @@ -2,6 +2,9 @@ {-# LANGUAGE TypeFamilies #-} module Database.Esqueleto.Experimental.ToMaybe + ( module Database.Esqueleto.Experimental.ToMaybe + , Nullable + ) where import Database.Esqueleto.Internal.Internal hiding (From(..), from, on) From c5fdb79d5d4e991f8a300d7a47ca056237b49b9f Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 8 Jan 2025 13:20:02 -0700 Subject: [PATCH 2/8] Fixity on ilike --- src/Database/Esqueleto/Experimental.hs | 1 + src/Database/Esqueleto/Internal/Internal.hs | 39 +++++++++++++++++++++ src/Database/Esqueleto/PostgreSQL.hs | 4 ++- 3 files changed, 43 insertions(+), 1 deletion(-) diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs index 709a85806..22aa12c63 100644 --- a/src/Database/Esqueleto/Experimental.hs +++ b/src/Database/Esqueleto/Experimental.hs @@ -54,6 +54,7 @@ module Database.Esqueleto.Experimental , ToAliasReference(..) , ToSqlSetOperation(..) , SqlSelect + , Nullable -- * The Normal Stuff , where_ diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index f82c982f0..8de4e426b 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -1283,6 +1283,45 @@ case_ = unsafeSqlCase toBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent))) toBaseId = veryUnsafeCoerceSqlExprValue +-- | The inverse of 'toBaseId'. Note that this is somewhat less "safe" than +-- 'toBaseId'. Calling 'toBaseId' will usually mean that a foreign key +-- constraint is present that guarantees the presence of the base ID. +-- 'fromBaseId' has no such guarantee. Consider the code example given in +-- 'toBaseId': +-- +-- @ +-- Bar +-- barNum Int +-- Foo +-- bar BarId +-- fooNum Int +-- Primary bar +-- @ +-- +-- @ +-- instance ToBaseId Foo where +-- type BaseEnt Foo = Bar +-- toBaseIdWitness barId = FooKey barId +-- @ +-- +-- The type of 'toBaseId' for @Foo@ would be: +-- +-- @ +-- toBaseId :: SqlExpr (Value FooId) -> SqlExpr (Value BarId) +-- @ +-- +-- The foreign key constraint on @Foo@ means that every @FooId@ points to +-- a @BarId@ in the database. However, 'fromBaseId' will not have this: +-- +-- @ +-- fromBaseId :: SqlExpr (Value BarId) -> SqlExpr (Value FooId) +-- @ +-- +-- +-- +-- @since 3.6.0.0 +fromBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent))) + -- Fixity declarations infixl 9 ^., ?. infixl 7 *., /. diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs index e84bb0eb0..430b083d6 100644 --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/src/Database/Esqueleto/PostgreSQL.hs @@ -137,7 +137,7 @@ distinctOn exprs = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs }) -- ... -- @ -- --- @since 3.6.0 +-- @since 3.6.0.0 distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery () distinctOnOrderBy exprs = do distinctOn (toDistinctOn <$> exprs) @@ -151,6 +151,7 @@ distinctOnOrderBy exprs = do $ TL.replace " ASC" "" $ TLB.toLazyText b , vals ) + -- | Empty array literal. (@val []@) does unfortunately not work emptyArray :: SqlExpr (Value [a]) emptyArray = unsafeSqlValue "'{}'" @@ -680,6 +681,7 @@ forKeyShareOf lockableEntities onLockedBehavior = -- @since 2.2.3 ilike :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool) ilike = unsafeSqlBinOp " ILIKE " +infixr 2 `ilike` -- | @WITH@ @MATERIALIZED@ clause is used to introduce a -- [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression) From 70c99854f9010db43ad4786a33f801d3682badfa Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 8 Jan 2025 13:23:24 -0700 Subject: [PATCH 3/8] lolwhoops --- changelog.md | 2 ++ src/Database/Esqueleto.hs | 2 +- src/Database/Esqueleto/Experimental.hs | 1 + src/Database/Esqueleto/Internal/Internal.hs | 5 ++--- src/Database/Esqueleto/Legacy.hs | 2 +- 5 files changed, 7 insertions(+), 5 deletions(-) diff --git a/changelog.md b/changelog.md index 75bafb315..62c51dd99 100644 --- a/changelog.md +++ b/changelog.md @@ -69,6 +69,8 @@ from non-Internal modules in a future release. Smart constructors replace them, and you may need to import them from a different database-specific module. + - [#]() + - `fromBaseId` is introduced as the inverse of `toBaseId`. 3.5.14.0 ======== diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 17922c9a6..5780dea39 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -66,7 +66,7 @@ module Database.Esqueleto {-# WARNING "This module will switch over to the Exper , subList_select, valList, justList , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) - , case_, toBaseId + , case_, toBaseId, fromBaseId , subSelect , subSelectMaybe , subSelectCount diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs index 22aa12c63..c9a776ccd 100644 --- a/src/Database/Esqueleto/Experimental.hs +++ b/src/Database/Esqueleto/Experimental.hs @@ -154,6 +154,7 @@ module Database.Esqueleto.Experimental , case_ , toBaseId + , fromBaseId , subSelect , subSelectMaybe , subSelectCount diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 8de4e426b..5daebb6c8 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -1317,10 +1317,9 @@ toBaseId = veryUnsafeCoerceSqlExprValue -- fromBaseId :: SqlExpr (Value BarId) -> SqlExpr (Value FooId) -- @ -- --- --- -- @since 3.6.0.0 -fromBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent))) +fromBaseId :: ToBaseId ent => SqlExpr (Value (Key (BaseEnt ent))) -> SqlExpr (Value (Key ent)) +fromBaseId = veryUnsafeCoerceSqlExprValue -- Fixity declarations infixl 9 ^., ?. diff --git a/src/Database/Esqueleto/Legacy.hs b/src/Database/Esqueleto/Legacy.hs index e45250398..33d2349d6 100644 --- a/src/Database/Esqueleto/Legacy.hs +++ b/src/Database/Esqueleto/Legacy.hs @@ -67,7 +67,7 @@ module Database.Esqueleto.Legacy , subList_select, valList, justList , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) - , case_, toBaseId + , case_, toBaseId, fromBaseId , subSelect , subSelectMaybe , subSelectCount From d80850e48ce7628be8d7f2cf6d9d26e7a47942cb Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 8 Jan 2025 13:29:34 -0700 Subject: [PATCH 4/8] changelog link --- changelog.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.md b/changelog.md index 62c51dd99..ba660c5fc 100644 --- a/changelog.md +++ b/changelog.md @@ -69,7 +69,7 @@ from non-Internal modules in a future release. Smart constructors replace them, and you may need to import them from a different database-specific module. - - [#]() + - [#425](https://github.com/bitemyapp/esqueleto/pull/425) - `fromBaseId` is introduced as the inverse of `toBaseId`. 3.5.14.0 From 3acab35f07ec8560edaa031c6d4054560a764401 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 9 Jan 2025 18:03:48 -0700 Subject: [PATCH 5/8] add toBaseIdMaybe and fromBaseIdMaybe --- changelog.md | 1 + src/Database/Esqueleto.hs | 2 +- src/Database/Esqueleto/Experimental.hs | 2 ++ src/Database/Esqueleto/Internal/Internal.hs | 23 ++++++++++++++++++++- src/Database/Esqueleto/Legacy.hs | 2 +- 5 files changed, 27 insertions(+), 3 deletions(-) diff --git a/changelog.md b/changelog.md index ba660c5fc..748012e3d 100644 --- a/changelog.md +++ b/changelog.md @@ -71,6 +71,7 @@ database-specific module. - [#425](https://github.com/bitemyapp/esqueleto/pull/425) - `fromBaseId` is introduced as the inverse of `toBaseId`. + - `toBaseIdMaybe` and `fromBaseIdMaybe` are introduced. 3.5.14.0 ======== diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 5780dea39..254f0497c 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -66,7 +66,7 @@ module Database.Esqueleto {-# WARNING "This module will switch over to the Exper , subList_select, valList, justList , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) - , case_, toBaseId, fromBaseId + , case_, toBaseId, fromBaseId, toBaseIdMaybe, fromBaseIdMaybe , subSelect , subSelectMaybe , subSelectCount diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs index c9a776ccd..1c0e33648 100644 --- a/src/Database/Esqueleto/Experimental.hs +++ b/src/Database/Esqueleto/Experimental.hs @@ -154,7 +154,9 @@ module Database.Esqueleto.Experimental , case_ , toBaseId + , toBaseIdMaybe , fromBaseId + , fromBaseIdMaybe , subSelect , subSelectMaybe , subSelectCount diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 5daebb6c8..304e8fe78 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -1283,6 +1283,15 @@ case_ = unsafeSqlCase toBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent))) toBaseId = veryUnsafeCoerceSqlExprValue +-- | Like 'toBaseId', but works on 'Maybe' keys. +-- +-- @since 3.6.0.0 +toBaseIdMaybe + :: (ToBaseId ent) + => SqlExpr (Value (Maybe (Key ent))) + -> SqlExpr (Value (Maybe (Key (BaseEnt ent)))) +toBaseIdMaybe = veryUnsafeCoerceSqlExprValue + -- | The inverse of 'toBaseId'. Note that this is somewhat less "safe" than -- 'toBaseId'. Calling 'toBaseId' will usually mean that a foreign key -- constraint is present that guarantees the presence of the base ID. @@ -1318,9 +1327,21 @@ toBaseId = veryUnsafeCoerceSqlExprValue -- @ -- -- @since 3.6.0.0 -fromBaseId :: ToBaseId ent => SqlExpr (Value (Key (BaseEnt ent))) -> SqlExpr (Value (Key ent)) +fromBaseId + :: (ToBaseId ent) + => SqlExpr (Value (Key (BaseEnt ent))) + -> SqlExpr (Value (Key ent)) fromBaseId = veryUnsafeCoerceSqlExprValue +-- | As 'fromBaseId', but works on 'Maybe' keys. +-- +-- @since 3.6.0.0 +fromBaseIdMaybe + :: (ToBaseId ent) + => SqlExpr (Value (Maybe (Key (BaseEnt ent)))) + -> SqlExpr (Value (Maybe (Key ent))) +fromBaseIdMaybe = veryUnsafeCoerceSqlExprValue + -- Fixity declarations infixl 9 ^., ?. infixl 7 *., /. diff --git a/src/Database/Esqueleto/Legacy.hs b/src/Database/Esqueleto/Legacy.hs index 33d2349d6..62b801f6d 100644 --- a/src/Database/Esqueleto/Legacy.hs +++ b/src/Database/Esqueleto/Legacy.hs @@ -67,7 +67,7 @@ module Database.Esqueleto.Legacy , subList_select, valList, justList , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) - , case_, toBaseId, fromBaseId + , case_, toBaseId, fromBaseId, fromBaseIdMaybe, toBaseIdMaybe , subSelect , subSelectMaybe , subSelectCount From bcd849cc01e7c9d0072131f9f03137fecdc38279 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Fri, 10 Jan 2025 14:01:20 -0700 Subject: [PATCH 6/8] start sketching out the sqlcoerce class --- src/Database/Esqueleto/Internal/Internal.hs | 61 +++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 304e8fe78..a70ca7f5f 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# language AllowAmbiguousTypes #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DataKinds #-} @@ -36,6 +37,8 @@ -- tracker so we can safely support it. module Database.Esqueleto.Internal.Internal where +import Data.Typeable (TypeRep, typeRep) +import Data.Coerce (Coercible) import Control.Applicative ((<|>)) import Control.Arrow (first, (***)) import Control.Exception (Exception, throw, throwIO) @@ -2510,6 +2513,64 @@ type role SqlExpr nominal veryUnsafeCoerceSqlExpr :: SqlExpr a -> SqlExpr b veryUnsafeCoerceSqlExpr (ERaw m k) = ERaw m k +-- | While 'veryUnsafeCoerceSqlExpr' allows you to coerce anything at all, this +-- requires that the two types are 'Coercible' in Haskell. This is not truly +-- safe: after all, the point of @newtype@ is to allow you to provide different +-- instances of classes like 'PersistFieldSql' and 'SqlSelect'. Using this may +-- break your code if you change the underlying SQL representation. +-- +-- @since 3.6.0.0 +unsafeCoerceSqlExpr :: (Coercible a b) => SqlExpr a -> SqlExpr b +unsafeCoerceSqlExpr = veryUnsafeCoerceSqlExpr + +-- | This type class provides a relation between two types @arg@ and @result@ +-- such that @arg@ can be coerced into @result@ safely. +-- +-- For this to be generally true, you should ensure that the 'sqlType' method +-- agrees for each type. See 'testSqlCoerce' for a function which does this. +-- +-- You will likely want to write bidirectional instances. That is, for two types +-- @A@ and @B@, you'll likely want to write: +-- +-- @ +-- instance SqlCoerce A B +-- +-- instance SqlCoerce B A +-- @ +-- +-- That way, you can coerce along either way. +-- +-- @since 3.6.0.0 +class SqlCoerce arg result where + -- | A Haskell value-level witness that you can safely + -- + -- @since 3.6.0.0 + sqlCoerceWitness :: arg -> result + + -- | Included as a class member to make importing the function easier. + -- However, this is defaulted to 'veryUnsafeCoerceSqlExpr', so you + -- probably don't want to define your own implementations. + sqlCoerce :: SqlExpr arg -> SqlExpr result + sqlCoerce = veryUnsafeCoerceSqlExpr + +-- | This function can be used to test whether or not a 'SqlCoerce' instance is +-- safe or not. If the two underlying 'sqlType' are equal, then this returns +-- @'Right' ()@. Otherwise, it returns a 'Left' with the two 'TypeRep's, +-- allowing you to render failure how you'd like. +-- +-- @since 3.6.0.0 +testSqlCoerce + :: forall arg result + . ( Typeable arg, PersistFieldSql arg + , Typeable result, PersistFieldSql result + , SqlCoerce arg result + ) + => Either (TypeRep, TypeRep) () +testSqlCoerce = + if sqlType (Proxy @arg) == sqlType (Proxy @result) + then pure () + else Left (typeRep (Proxy @arg), typeRep (Proxy @result)) + -- | Folks often want the ability to promote a Haskell function into the -- 'SqlExpr' expression language - and naturally reach for 'fmap'. -- Unfortunately, this is impossible. We cannot send *functions* to the From 9fd81b56a866693b0808fdc6218de8fdfdc4436e Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Mon, 13 Jan 2025 10:56:53 -0700 Subject: [PATCH 7/8] no sqlcoerce yet --- changelog.md | 3 ++ src/Database/Esqueleto/Internal/Internal.hs | 48 --------------------- 2 files changed, 3 insertions(+), 48 deletions(-) diff --git a/changelog.md b/changelog.md index 748012e3d..2049c6c60 100644 --- a/changelog.md +++ b/changelog.md @@ -64,6 +64,9 @@ - The ability to `coerce` `SqlExpr` was removed. Instead, use `veryUnsafeCoerceSqlExpr`. See the documentation on `veryUnsafeCoerceSqlExpr` for safe use example. + - `unsafeCeorceSqlExpr` is provided as an option when the underlying + Haskell types are coercible. This is still unsafe, as different + `PersistFieldSql` instances may be at play. - [#420](https://github.com/bitemyapp/esqueleto/pull/421) - The `LockingKind` constructors are deprecated, and will be removed from non-Internal modules in a future release. Smart constructors diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index a70ca7f5f..9541c90b7 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -2523,54 +2523,6 @@ veryUnsafeCoerceSqlExpr (ERaw m k) = ERaw m k unsafeCoerceSqlExpr :: (Coercible a b) => SqlExpr a -> SqlExpr b unsafeCoerceSqlExpr = veryUnsafeCoerceSqlExpr --- | This type class provides a relation between two types @arg@ and @result@ --- such that @arg@ can be coerced into @result@ safely. --- --- For this to be generally true, you should ensure that the 'sqlType' method --- agrees for each type. See 'testSqlCoerce' for a function which does this. --- --- You will likely want to write bidirectional instances. That is, for two types --- @A@ and @B@, you'll likely want to write: --- --- @ --- instance SqlCoerce A B --- --- instance SqlCoerce B A --- @ --- --- That way, you can coerce along either way. --- --- @since 3.6.0.0 -class SqlCoerce arg result where - -- | A Haskell value-level witness that you can safely - -- - -- @since 3.6.0.0 - sqlCoerceWitness :: arg -> result - - -- | Included as a class member to make importing the function easier. - -- However, this is defaulted to 'veryUnsafeCoerceSqlExpr', so you - -- probably don't want to define your own implementations. - sqlCoerce :: SqlExpr arg -> SqlExpr result - sqlCoerce = veryUnsafeCoerceSqlExpr - --- | This function can be used to test whether or not a 'SqlCoerce' instance is --- safe or not. If the two underlying 'sqlType' are equal, then this returns --- @'Right' ()@. Otherwise, it returns a 'Left' with the two 'TypeRep's, --- allowing you to render failure how you'd like. --- --- @since 3.6.0.0 -testSqlCoerce - :: forall arg result - . ( Typeable arg, PersistFieldSql arg - , Typeable result, PersistFieldSql result - , SqlCoerce arg result - ) - => Either (TypeRep, TypeRep) () -testSqlCoerce = - if sqlType (Proxy @arg) == sqlType (Proxy @result) - then pure () - else Left (typeRep (Proxy @arg), typeRep (Proxy @result)) - -- | Folks often want the ability to promote a Haskell function into the -- 'SqlExpr' expression language - and naturally reach for 'fmap'. -- Unfortunately, this is impossible. We cannot send *functions* to the From 498ed7fe393cd2177dce87309847bd421bbdab38 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Mon, 13 Jan 2025 11:32:09 -0700 Subject: [PATCH 8/8] ok for convenience --- src/Database/Esqueleto/Internal/Internal.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 9541c90b7..8b7e0d298 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -2523,6 +2523,13 @@ veryUnsafeCoerceSqlExpr (ERaw m k) = ERaw m k unsafeCoerceSqlExpr :: (Coercible a b) => SqlExpr a -> SqlExpr b unsafeCoerceSqlExpr = veryUnsafeCoerceSqlExpr +-- | Like 'unsafeCoerceSqlExpr' but for the common case where you are +-- coercing a 'Value'. +-- +-- @since 3.6.0.0 +unsafeCoerceSqlExprValue :: (Coercible a b) => SqlExpr (Value a) -> SqlExpr (Value b) +unsafeCoerceSqlExprValue = veryUnsafeCoerceSqlExpr + -- | Folks often want the ability to promote a Haskell function into the -- 'SqlExpr' expression language - and naturally reach for 'fmap'. -- Unfortunately, this is impossible. We cannot send *functions* to the