diff --git a/src/Database/Esqueleto/Experimental/ToMaybe.hs b/src/Database/Esqueleto/Experimental/ToMaybe.hs index 0677bfb9c..44471285c 100644 --- a/src/Database/Esqueleto/Experimental/ToMaybe.hs +++ b/src/Database/Esqueleto/Experimental/ToMaybe.hs @@ -7,10 +7,6 @@ module Database.Esqueleto.Experimental.ToMaybe import Database.Esqueleto.Internal.Internal hiding (From(..), from, on) import Database.Esqueleto.Internal.PersistentImport (Entity(..)) -type family Nullable a where - Nullable (Maybe a) = a - Nullable a = a - class ToMaybe a where type ToMaybeT a toMaybe :: a -> ToMaybeT a diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 709e934d0..47a7d5670 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -665,7 +665,10 @@ nothing = unsafeSqlValue "NULL" -- | Join nested 'Maybe's in a 'Value' into one. This is useful when -- calling aggregate functions on nullable fields. -joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ)) +joinV + :: (NullableFieldProjection typ typ') + => SqlExpr (Value (Maybe typ)) + -> SqlExpr (Value (Maybe typ')) joinV = veryUnsafeCoerceSqlExprValue @@ -2478,11 +2481,18 @@ instance -- -- @since 3.5.4.0 instance - (PersistEntity rec, PersistField typ, SymbolToField sym rec typ) + (PersistEntity rec, PersistField typ, PersistField typ', SymbolToField sym rec typ + , NullableFieldProjection typ typ' + , HasField sym (SqlExpr (Maybe (Entity rec))) (SqlExpr (Value (Maybe typ'))) + ) => - HasField sym (SqlExpr (Maybe (Entity rec))) (SqlExpr (Value (Maybe typ))) + HasField sym (SqlExpr (Maybe (Entity rec))) (SqlExpr (Value (Maybe typ'))) where - getField expr = expr ?. symbolToField @sym + getField expr = veryUnsafeCoerceSqlExpr (expr ?. symbolToField @sym) + +class NullableFieldProjection typ typ' +instance {-# incoherent #-} (typ ~ typ') => NullableFieldProjection (Maybe typ) typ' +instance {-# overlappable #-} (typ ~ typ') => NullableFieldProjection typ typ' -- | Data type to support from hack data PreprocessedFrom a = PreprocessedFrom a FromClause @@ -4263,3 +4273,7 @@ associateJoin = foldr f start (\(oneOld, manyOld) (_, manyNew) -> (oneOld, manyNew ++ manyOld )) (entityKey one) (entityVal one, [many]) + +type family Nullable a where + Nullable (Maybe a) = a + Nullable a = a diff --git a/test/Common/Test.hs b/test/Common/Test.hs index 37df01fca..75b3031bc 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -2487,7 +2487,7 @@ testOverloadedRecordDot = describe "OverloadedRecordDot" $ do pure bp.title describe "with SqlExpr (Maybe (Entity rec))" $ do itDb "lets you project from a Maybe record" $ do - select $ do + void $ select $ do p :& mbp <- Experimental.from $ table @Person `leftJoin` table @BlogPost @@ -2496,6 +2496,20 @@ testOverloadedRecordDot = describe "OverloadedRecordDot" $ do just p.id ==. mbp.authorId pure (p.id, mbp.title) + itDb "joins Maybe together" $ do + void $ select $ do + deed :& lord <- + Experimental.from $ + table @Deed + `leftJoin` table @Lord + `Experimental.on` do + \(deed :& lord) -> + lord.id ==. just deed.ownerId + where_ $ joinV lord.dogs >=. just (val 10) + pure lord + + + #else it "is only supported in GHC 9.2 or above" $ \_ -> do pending