Implement Maybe related things for Esqueleto.Record

examples/esqueleto-examples.cabal

@@ -1,10 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.35.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d5fddaf37d0c2f27fb2446f5038899d766102efd74ccfe4c7bcd02c61837e6b6
+-- hash: ec7b9640e401d9b5f6939c8ac50f7d322b4b00354179825fd41ef4ea92401aaa
 
 name:           esqueleto-examples
 version:        0.0.0.0
@@ -44,6 +44,6 @@ executable blog-example
     , persistent-postgresql
     , transformers-base
     , unliftio-core
+  default-language: Haskell2010
   if flag(werror)
     ghc-options: -Werror
-  default-language: Haskell2010

src/Database/Esqueleto/Experimental/ToMaybe.hs

@@ -1,11 +1,16 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Database.Esqueleto.Experimental.ToMaybe
     where
 
+import Data.Proxy
 import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
-import Database.Esqueleto.Internal.PersistentImport (Entity(..))
+import Database.Esqueleto.Internal.PersistentImport
+    (PersistEntity (..), Entity(..), PersistField)
 
 type family Nullable a where
     Nullable (Maybe a) = a
@@ -15,27 +20,58 @@ class ToMaybe a where
     type ToMaybeT a
     toMaybe :: a -> ToMaybeT a
 
+class (ToMaybe a) => HasNulls a where
+    mkNothing :: proxy a -> ToMaybeT a
+
 instance ToMaybe (SqlExpr (Maybe a)) where
     type ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a)
     toMaybe = id
 
+instance (SqlSelect (SqlExpr (Maybe a)) r) => HasNulls (SqlExpr (Maybe a)) where
+    mkNothing p = ERaw noMeta $ \_ _ -> nullsFor p
+
 instance ToMaybe (SqlExpr (Entity a)) where
     type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))
     toMaybe (ERaw f m) = (ERaw f m)
 
+instance (PersistEntity a) => HasNulls (SqlExpr (Entity a)) where
+    mkNothing p = ERaw noMeta $ \_ _ -> nullsFor p
+
 instance ToMaybe (SqlExpr (Value a)) where
     type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a)))
     toMaybe = veryUnsafeCoerceSqlExprValue
 
+instance (PersistField a) => HasNulls (SqlExpr (Value a)) where
+    mkNothing p = ERaw noMeta $ \_ _ -> nullsFor p
 
 instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where
     type ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b)
     toMaybe (a, b) = (toMaybe a, toMaybe b)
 
+instance forall a b. (HasNulls a, HasNulls b) => HasNulls (a, b) where
+    mkNothing _ = (mkNothing (Proxy @a), mkNothing (Proxy @b))
+
 instance ( ToMaybe a , ToMaybe b , ToMaybe c) => ToMaybe (a,b,c) where
     type ToMaybeT (a, b, c) = (ToMaybeT a, ToMaybeT b, ToMaybeT c)
     toMaybe = to3 . toMaybe . from3
 
+instance forall a b c. (HasNulls a, HasNulls b, HasNulls c)
+    => HasNulls (a, b, c) where
+        mkNothing _ =
+            ( mkNothing (Proxy @a)
+            , mkNothing (Proxy @b)
+            , mkNothing (Proxy @c)
+            )
+
+instance forall a b c d. (HasNulls a, HasNulls b, HasNulls c, HasNulls d)
+    => HasNulls (a, b, c, d) where
+        mkNothing _ =
+            ( mkNothing (Proxy @a)
+            , mkNothing (Proxy @b)
+            , mkNothing (Proxy @c)
+            , mkNothing (Proxy @d)
+            )
+
 instance ( ToMaybe a , ToMaybe b , ToMaybe c , ToMaybe d) => ToMaybe (a,b,c,d) where
     type ToMaybeT (a, b, c, d) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d)
     toMaybe = to4 . toMaybe . from4

src/Database/Esqueleto/Internal/Internal.hs

@@ -653,6 +653,21 @@ just = veryUnsafeCoerceSqlExprValue
 nothing :: SqlExpr (Value (Maybe typ))
 nothing = unsafeSqlValue "NULL"
 
+-- | Provides a query fragment for an amount of @NULL@ values that would work
+-- for the given input type.
+nullsFor :: SqlSelect db typ => proxy db -> (TLB.Builder, [PersistValue])
+nullsFor prxy =
+    ( uncommas (replicate (sqlSelectColCount (fromVar prxy)) "NULL")
+    , mempty
+    )
+  where
+    fromVar :: proxy a -> Proxy a
+    fromVar _ = Proxy
+
+just' :: PersistEntity a => SqlExpr a -> SqlExpr (Maybe a)
+just' = coerce
+
+
 -- | 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))