bitemyapp · parsonsmatt · Jan 13, 2025 · Jan 8, 2025 · Jan 8, 2025 · Jan 8, 2025
diff --git a/changelog.md b/changelog.md
@@ -64,11 +64,17 @@
         - 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
           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`.
+        - `toBaseIdMaybe` and `fromBaseIdMaybe` are introduced.
 
 3.5.14.0
 ========

diff --git 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, toBaseIdMaybe, fromBaseIdMaybe
   , subSelect
   , subSelectMaybe
   , subSelectCount

diff --git 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_
@@ -153,6 +154,9 @@ module Database.Esqueleto.Experimental
 
     , case_
     , toBaseId
+    , toBaseIdMaybe
+    , fromBaseId
+    , fromBaseIdMaybe
     , subSelect
     , subSelectMaybe
     , subSelectCount

diff --git 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)

diff --git 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)
@@ -64,7 +67,7 @@
 import Data.Kind (Type)
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 import qualified Data.Monoid as Monoid
 import Data.Proxy (Proxy(..))
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -74,7 +77,7 @@
 import Data.Typeable (Typeable)
 import Database.Esqueleto.Internal.ExprParser (TableAccess(..), parseOnExpr)
 import Database.Esqueleto.Internal.PersistentImport
 import Database.Persist (EntityNameDB(..), FieldNameDB(..), SymbolToField(..))
 import qualified Database.Persist
 import Database.Persist.Sql.Util
       ( entityColumnCount
@@ -1283,6 +1286,65 @@
 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.
+-- '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 (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 *., /.
@@ -1473,7 +1535,7 @@
    unique = finalR uniqueConstructor
    -- there must be a better way to get the constrain name from a unique, make this not a list search
    filterF = (==) (persistUniqueToFieldNames unique) . uniqueFields
    uniqueDef = head . filter filterF . getEntityUniques . entityDef $ proxy

 -- | Render updates to be use in a SET clause for a given sql backend.
 --
@@ -2451,6 +2513,23 @@
 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
+
+-- | 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

diff --git 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, fromBaseIdMaybe, toBaseIdMaybe
   , subSelect
   , subSelectMaybe
   , subSelectCount

diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs
@@ -65,15 +65,15 @@
 import qualified Data.Text as Text
 import qualified Data.Text.Internal.Builder as TLB
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TLB
 import Data.Time.Clock (UTCTime)
 import qualified Database.Esqueleto.Experimental as Ex
 import qualified Database.Esqueleto.Experimental.From as Ex
 import Database.Esqueleto.Experimental.From.CommonTableExpression
 import Database.Esqueleto.Experimental.From.SqlSetOperation
 import Database.Esqueleto.Experimental.ToAlias
 import Database.Esqueleto.Experimental.ToAliasReference
 import Database.Esqueleto.Internal.Internal hiding
       (From(..), ilike, distinctOn, distinctOnOrderBy, from, on, random_)
 import Database.Esqueleto.Internal.PersistentImport hiding
       (uniqueFields, upsert, upsertBy)
@@ -137,7 +137,7 @@
 --   ...
 -- @
 --
--- @since 3.6.0
+-- @since 3.6.0.0
 distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery ()
 distinctOnOrderBy exprs = do
     distinctOn (toDistinctOn <$> exprs)
@@ -151,6 +151,7 @@
               $ TL.replace " ASC" ""
               $ TLB.toLazyText b
             , vals )
+
 -- | Empty array literal. (@val []@) does unfortunately not work
 emptyArray :: SqlExpr (Value [a])
 emptyArray = unsafeSqlValue "'{}'"
@@ -665,7 +666,7 @@
 --
 -- @since 3.6.0.0
 forShare :: LockingKind
 forShare = ForShare

 -- | `FOR KEY SHARE OF` syntax for postgres locking
 -- allows locking of specific tables with a key share lock in a view or join
@@ -680,6 +681,7 @@
 -- @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)