diff --git a/examples/esqueleto-examples.cabal b/examples/esqueleto-examples.cabal index b8a5cf6be..f03c614f4 100644 --- a/examples/esqueleto-examples.cabal +++ b/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 diff --git a/src/Database/Esqueleto/Experimental/ToMaybe.hs b/src/Database/Esqueleto/Experimental/ToMaybe.hs index 0677bfb9c..25f4d2578 100644 --- a/src/Database/Esqueleto/Experimental/ToMaybe.hs +++ b/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 diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index bf70f8f2c..b10953d6c 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/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)) diff --git a/src/Database/Esqueleto/Record.hs b/src/Database/Esqueleto/Record.hs index 26c57fab2..f9444a28d 100644 --- a/src/Database/Esqueleto/Record.hs +++ b/src/Database/Esqueleto/Record.hs @@ -1,4 +1,12 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -8,24 +16,31 @@ {-# LANGUAGE ViewPatterns #-} module Database.Esqueleto.Record - ( deriveEsqueletoRecord - , deriveEsqueletoRecordWith - - , DeriveEsqueletoRecordSettings(..) - , defaultDeriveEsqueletoRecordSettings - ) where - + ( deriveEsqueletoRecord + , deriveEsqueletoRecordWith + + , DeriveEsqueletoRecordSettings(..) + , defaultDeriveEsqueletoRecordSettings + , projectMaybeRecord + , getFieldP + , SqlMaybe(..) + ) where + +import GHC.Records +import Data.Typeable +import Database.Esqueleto.Experimental.ToMaybe import Control.Monad.Trans.State.Strict (StateT(..), evalStateT) import Data.Proxy (Proxy(..)) import Database.Esqueleto.Experimental - (Entity, PersistValue, SqlExpr, Value(..), (:&)(..)) + (just, Entity, PersistValue, SqlExpr, Value(..), (:&)(..)) import Database.Esqueleto.Experimental.ToAlias (ToAlias(..)) import Database.Esqueleto.Experimental.ToAliasReference (ToAliasReference(..)) -import Database.Esqueleto.Internal.Internal (SqlSelect(..)) +import Database.Esqueleto.Internal.Internal (SqlSelect(..), nullsFor, noMeta, SqlExpr(..)) import Language.Haskell.TH import Language.Haskell.TH.Syntax import Data.Bifunctor (first) import Data.Text (Text) +import qualified Data.Text as Text import Control.Monad (forM) import Data.Foldable (foldl') import GHC.Exts (IsString(fromString)) @@ -163,19 +178,56 @@ defaultDeriveEsqueletoRecordSettings = DeriveEsqueletoRecordSettings -- @since 3.5.8.0 deriveEsqueletoRecordWith :: DeriveEsqueletoRecordSettings -> Name -> Q [Dec] deriveEsqueletoRecordWith settings originalName = do - info <- getRecordInfo settings originalName - -- It would be nicer to use `mconcat` here but I don't think the right - -- instance is available in GHC 8. - recordDec <- makeSqlRecord info - sqlSelectInstanceDec <- makeSqlSelectInstance info - toAliasInstanceDec <- makeToAliasInstance info - toAliasReferenceInstanceDec <- makeToAliasReferenceInstance info - pure - [ recordDec - , sqlSelectInstanceDec - , toAliasInstanceDec - , toAliasReferenceInstanceDec - ] + info <- getRecordInfo settings originalName + -- It would be nicer to use `mconcat` here but I don't think the right + -- instance is available in GHC 8. + recordDec <- makeSqlRecord info + sqlSelectInstanceDec <- makeSqlSelectInstance info + toAliasInstanceDec <- makeToAliasInstance info + let sqlNameTyp = conT (sqlName info) + nameTyp = conT (name info) + -- sym = varT (mkName "sym") + maybeInstances <- + [d| + instance SqlSelect (SqlMaybe $(sqlNameTyp)) (Maybe $(nameTyp)) where + sqlSelectProcessRow = sqlSelectProcessRowOptional + sqlSelectColCount = sqlSelectColCount . unMaybeProxy + sqlSelectCols = $(sqlSelectColsExpMaybe info) + + instance ToAlias (SqlMaybe $(sqlNameTyp)) where + toAlias (SqlMaybe a) = + fmap SqlMaybe (toAlias a) + + instance ToAliasReference (SqlMaybe $(sqlNameTyp)) where + toAliasReference aliasSource (SqlMaybe a) = + fmap SqlMaybe (toAliasReference aliasSource a) + + instance ToMaybe $(sqlNameTyp) where + type ToMaybeT $(sqlNameTyp) = SqlMaybe $(sqlNameTyp) + toMaybe = SqlMaybe + +-- instance HasNulls $(sqlNameTyp) where +-- mkNothing _ = SqlMaybe _f + |] + + + maybeHasFieldInstances <- fmap mconcat $ forM (sqlFields info) $ \(sqlFieldName, sqlFieldType) -> do + nm <- newName (show sqlFieldName) + let binding = + LamE [RecP (sqlName info) [ (sqlFieldName, VarP nm) ]] (VarE nm) + [d| + instance (r ~ ToMaybeT $(pure sqlFieldType) ) => HasField $(litT (strTyLit $ show sqlFieldName)) (SqlMaybe $(sqlNameTyp)) r where + getField mrec = + projectMaybeRecord mrec $(pure binding) + |] + + toAliasReferenceInstanceDec <- makeToAliasReferenceInstance info + pure $ + [ recordDec + , sqlSelectInstanceDec + , toAliasInstanceDec + , toAliasReferenceInstanceDec + ] <> maybeInstances <> maybeHasFieldInstances -- | Information about a record we need to generate the declarations. -- We compute this once and then pass it around to save on complexity / @@ -249,10 +301,10 @@ makeSqlName settings name = mkName $ sqlNameModifier settings $ nameBase name -- | Transforms a record field type into a corresponding `SqlExpr` type. -- +-- * If there exists an instance @'SqlSelect' sql x@, then @x@ is transformed into @sql@. -- * @'Entity' x@ is transformed into @'SqlExpr' ('Entity' x)@. -- * @'Maybe' ('Entity' x)@ is transformed into @'SqlExpr' ('Maybe' ('Entity' x))@. -- * @x@ is transformed into @'SqlExpr' ('Value' x)@. --- * If there exists an instance @'SqlSelect' sql x@, then @x@ is transformed into @sql@. -- -- This function should match `sqlSelectProcessRowPat`. sqlFieldType :: Type -> Q Type @@ -275,6 +327,31 @@ sqlFieldType fieldType = do `AppT` ((ConT ''Value) `AppT` fieldType) +applyMaybeInsideValue :: Type -> Type +applyMaybeInsideValue typ = + fromMaybe typ $ do + inner <- takeValueType typ + let mkValue = AppT (ConT ''Value) + mkMaybe = AppT (ConT ''Maybe) + pure $ mkValue (mkMaybe inner) + +takeTypeConstructorApplicationName :: Name -> Type -> Maybe Type +takeTypeConstructorApplicationName nm typ = do + AppT (ConT ((==) nm -> True)) rest <- Just typ + pure rest + +takeValueType :: Type -> Maybe Type +takeValueType = + takeTypeConstructorApplicationName ''Value + +takeEntityType :: Type -> Maybe Type +takeEntityType = + takeTypeConstructorApplicationName ''Entity + +takeMaybeType :: Type -> Maybe Type +takeMaybeType = + takeTypeConstructorApplicationName ''Maybe + -- | Generates the declaration for an @Sql@-prefixed record, given the original -- record's information. makeSqlRecord :: RecordInfo -> Q Dec @@ -302,6 +379,49 @@ makeSqlSelectInstance info@RecordInfo {..} = do pure $ InstanceD overlap instanceConstraints instanceType [sqlSelectColsDec', sqlSelectColCountDec', sqlSelectProcessRowDec'] + +-- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance of +-- `SqlMaybe` +sqlSelectColsExpMaybe :: RecordInfo -> Q Exp +sqlSelectColsExpMaybe RecordInfo {..} = do + -- Pairs of record field names and local variable names. + fieldNames <- forM sqlFields (\(name', _type) -> do + var <- newName $ nameBase name' + pure (name', var)) + + -- Patterns binding record fields to local variables. + let fieldPatterns :: [Q FieldPat] + fieldPatterns = map pure [(name', VarP var) | (name', var) <- fieldNames] + + -- Local variables for fields joined with `:&` in a single expression. + joinedFields :: Exp + joinedFields = + case snd `map` fieldNames of + [] -> TupE [] + [f1] -> VarE f1 + f1 : rest -> + let helper lhs field = + InfixE + (Just lhs) + (ConE '(:&)) + (Just $ AppE (VarE 'toMaybe) (VarE field)) + in foldl' helper (AppE (VarE 'toMaybe) (VarE f1)) rest + + identInfo <- newName "identInfo" + -- Roughly: + -- sqlSelectCols $identInfo SqlFoo{..} = sqlSelectCols $identInfo $joinedFields + [e| \ $(varP identInfo) (SqlMaybe $(recP sqlName fieldPatterns)) -> + sqlSelectCols $(varE identInfo) ( $(pure joinedFields) ) |] +-- pure $ +-- LamE +-- [ VarP identInfo +-- , RecP sqlName fieldPatterns +-- ] +-- (VarE 'sqlSelectCols +-- `AppE` VarE identInfo +-- `AppE` ParensE joinedFields +-- ) + -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance. sqlSelectColsDec :: RecordInfo -> Q Dec sqlSelectColsDec RecordInfo {..} = do @@ -347,6 +467,9 @@ sqlSelectColsDec RecordInfo {..} = do [] ] +unMaybeProxy :: Proxy (SqlMaybe a) -> Proxy a +unMaybeProxy _ = Proxy + -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance. sqlSelectColCountDec :: RecordInfo -> Q Dec sqlSelectColCountDec RecordInfo {..} = do @@ -523,16 +646,28 @@ takeColumns :: forall a b. SqlSelect a b => StateT [PersistValue] (Either Text) b -takeColumns = StateT (\pvs -> - let targetColCount = - sqlSelectColCount (Proxy @a) - (target, other) = - splitAt targetColCount pvs - in if length target == targetColCount +takeColumns = StateT $ \pvs -> do + let targetColCount = + sqlSelectColCount (Proxy @a) + (target, other) = + splitAt targetColCount pvs + targetLength = + length target + if targetLength == targetColCount then do - value <- sqlSelectProcessRow target - Right (value, other) - else Left "Insufficient columns when trying to parse a column") + value <- sqlSelectProcessRow target + pure (value, other) + else + Left $ mconcat + [ "Insufficient columns when trying to parse a column: " + , "Expected ", tshow targetColCount, " columns, but got: " + , tshow targetLength, ".\n\n" + , "Columns:\n\t", tshow target + , "Other:\n\t", tshow other + ] + +tshow :: Show a => a -> Text +tshow = Text.pack . show -- | Get an error message for a non-record constructor. -- This module does not yet support non-record constructors, so we'll tell the @@ -652,3 +787,155 @@ toAliasReferenceDec RecordInfo {..} = do [] ] +sqlSelectProcessRowOptional + :: forall r a. (Typeable a, Typeable r, SqlSelect a r) + => [PersistValue] + -> Either Text (Maybe r) +sqlSelectProcessRowOptional pvs = + case sqlSelectProcessRow pvs of + Left err -> do + let actualLength = + length pvs + expectedLength = + sqlSelectColCount (Proxy :: Proxy a) + + if actualLength == expectedLength + then pure Nothing -- assuming that the problem is an "unexpected null" + else Left $ mconcat + [ "Column count incorrect: expected " + , tshow expectedLength + , " but got ", tshow actualLength," when trying to parse a " + , Text.pack (show (typeRep (Proxy @r))), " from a " + , Text.pack (show (typeRep (Proxy @a))) + , ".\nGiven error: ", err + ] + Right a -> + pure (Just a) + + +{- Uh oh... + +So, we start with a record. + + data X = X { x :: Int } + +Then we turn that into a SQL record. + + data SqlX = SqlX { x :: SqlExpr (Value Int) } + +With `OverloadedRecordDot`, you can refer to `sqlX.x` and get back what you +want. + +You can carry `Maybe`, `Entity`, and other records, and it works out fine. + +However, we need *something* for dealing with a nullable `SqlX`. Otherwise, we +cannot bring them into scope from left joins. + +My first attempt used `Maybe`. The nice thing here is that we get a totally +reasonable implementation, right up until we need to do field access. A first +attempt is something like: + + fmap (\SqlMyRecord {..} -> myName) myRecord + +However, this gives us a @Maybe (SqlExpr (Value Text))@, and not a @SqlExpr +(Value (Maybe Text))@. + +Consider the type of the maybe projection operator: + + (?.) :: ( PersistEntity val , PersistField typ) + => SqlExpr (Maybe (Entity val)) + -> EntityField val typ + -> SqlExpr (Value (Maybe typ)) + +`SqlExpr (Maybe (Entity val))` is merely `Maybe val` for a record. +So the type we need for a function is something like: + + _f + :: Maybe val + -> (val -> SqlExpr ret) + -> SqlExpr (Maybe ret) + +We cannot write an instance of `HasField` for `Maybe`, at all, due to +restrictions around what can or cannot be a valid instance. So `Maybe` isn't +a suitable type. + +However, we can't even assume `SqlExpr`. We don't have a `SqlExpr` that wraps +a record - only entity and maybe. So, we have to start with this: + + _f + :: + ( ToMaybe ret + ) + => Maybe val + -> (val -> ret) + -> ToMaybeT ret + +If the field has type `Entity a`, then the Sql record will have type `SqlExpr +(Entity a)`, and that tracks. If the field has type `Int`, then we get `SqlExpr +(Value Int)`, and that tracks fine too. If the field has type `Record`, then +we'll get `ToMaybeT Record`, which is `Maybe Record` - which is also fine. + +But what do we provide if the value is `Nothing`? + +If the value is 'Nothing', then we need to figure out how to produce a @ToMaybeT ret@ such that we get a @NULL@ for it back. + +This suggests that 'ToMaybeT' needs to evolve to give us a @nulls@, or +something... + +But, for now, let's make a separate class. + + -} + +projectMaybeRecord + :: forall val val' ret . + (ToMaybe ret ) + => SqlMaybe val + -> (val -> ret) + -> ToMaybeT ret +projectMaybeRecord (SqlMaybe record) k = + toMaybe (k record) + +getFieldP :: forall sym rec typ. HasField sym rec typ => Proxy sym -> rec -> typ +getFieldP _ = getField @sym + +projectMaybeRecordHasField + :: forall val ret sym. + (ToMaybe ret, HasField sym val ret) + => Proxy ret -> Proxy sym + -> SqlMaybe val + -> ToMaybeT ret +projectMaybeRecordHasField _ _ mrec = + projectMaybeRecord mrec (getField @sym) + +data X = X { x :: Int } +data SqlX = SqlX { x :: SqlExpr (Value Int) } + +instance + ( maybeR ~ ToMaybeT r + , HasField sym SqlX r + , ToMaybe r + ) + => HasField sym (SqlMaybe SqlX) maybeR where + getField mrec = + projectMaybeRecord mrec (getField @sym) + +x' :: (HasField "x" (Maybe SqlX) r) => Proxy r +x' = Proxy + +-- blah :: Maybe SqlX -> ToMaybeT (SqlExpr (Value Int)) +-- blah a = getField @"x" a + +-- | A 'SqlMaybe' is a type used to indicate that a record is nullable. +-- +-- To construct one, use 'toMaybe' on the 'ToMaybe' class. +-- +-- To access fields, use the 'HasField' interface, or the 'liftSqlMaybe' +-- function. +newtype SqlMaybe a = SqlMaybe a + +instance ToMaybe (SqlMaybe a) where + type ToMaybeT (SqlMaybe a) = SqlMaybe a + toMaybe = id + +-- instance (ToMaybeT a ~ SqlMaybe a) => HasNulls (SqlMaybe a) where +-- mkNothing _ = mkNothing (Proxy :: Proxy a) diff --git a/test/Common/Record.hs b/test/Common/Record.hs index 5cb1599ed..1c6bd35b8 100644 --- a/test/Common/Record.hs +++ b/test/Common/Record.hs @@ -1,4 +1,9 @@ +{-# OPTIONS_GHC -ddump-splices #-} + +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} @@ -19,15 +24,15 @@ -- Tests for `Database.Esqueleto.Record`. module Common.Record (testDeriveEsqueletoRecord) where +import Database.Esqueleto.Experimental.ToMaybe +import Data.Coerce +import GHC.Records +import Data.Proxy +import Database.Esqueleto.Internal.Internal hiding (from, on) import Common.Test.Import hiding (from, on) import Data.List (sortOn) import Database.Esqueleto.Experimental import Database.Esqueleto.Record - ( DeriveEsqueletoRecordSettings(..) - , defaultDeriveEsqueletoRecordSettings - , deriveEsqueletoRecord - , deriveEsqueletoRecordWith - ) data MyRecord = MyRecord @@ -40,6 +45,12 @@ data MyRecord = $(deriveEsqueletoRecord ''MyRecord) +doesThisWork :: SqlMyRecord -> SqlExpr (Value Text) +doesThisWork = getField @"myName" + +whatAboutThis :: SqlMaybe SqlMyRecord -> SqlExpr (Value (Maybe Text)) +whatAboutThis = getField @"myName" + myRecordQuery :: SqlQuery SqlMyRecord myRecordQuery = do user :& address <- from $ @@ -82,6 +93,39 @@ myNestedRecordQuery = do } } +data MyNestedRecordMaybe = MyNestedRecordMaybe + { myName :: Text + , myMaybeRecord :: Maybe MyRecord + } + deriving (Show, Eq) + +deriveEsqueletoRecord ''MyNestedRecordMaybe + +data MaybeNestedTwice = MaybeNestedTwice + { blah :: Int + , nestedTwice :: Maybe MyNestedRecordMaybe + } + deriving (Show, Eq) + +deriveEsqueletoRecord ''MaybeNestedTwice + +myNestedRecordMaybeQuery :: SqlQuery SqlMyNestedRecordMaybe +myNestedRecordMaybeQuery = do + user :& address <- + from $ + table @User + `leftJoin` table @Address + `on` do + \(user :& address) -> + user ^. #address ==. address ?. #id + pure + SqlMyNestedRecordMaybe + { myName = castString $ user ^. #name + , myMaybeRecord = + Nothing + } + + data MyModifiedRecord = MyModifiedRecord { myModifiedName :: Text @@ -180,6 +224,39 @@ testDeriveEsqueletoRecord = describe "deriveEsqueletoRecord" $ do } -> addr1 == addr2 -- The keys should match. _ -> False) + itDb "can select nested Maybe records" $ do + setup + records <- select myNestedRecordMaybeQuery + let sortedRecords = sortOn (\MyNestedRecordMaybe {myName} -> myName) records + liftIO $ sortedRecords !! 0 + `shouldSatisfy` + (\case MyNestedRecordMaybe + { myName = "Rebecca" + , myMaybeRecord = + Just MyRecord { myName = "Rebecca" + , myAge = Just 10 + , myUser = Entity _ User { userAddress = Nothing + , userName = "Rebecca" + } + , myAddress = Nothing + } + } -> True + _ -> False) + + liftIO $ sortedRecords !! 1 + `shouldSatisfy` + (\case MyNestedRecordMaybe + { myName = "Some Guy" + , myMaybeRecord = + Just MyRecord { myName = "Some Guy" + , myAge = Just 10 + , myUser = Entity _ User { userAddress = Just addr1 + , userName = "Some Guy" + } + , myAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"}) + } + } -> addr1 == addr2 -- The keys should match. + _ -> False) itDb "can be used in a CTE" $ do setup records <- select $ do @@ -235,3 +312,27 @@ testDeriveEsqueletoRecord = describe "deriveEsqueletoRecord" $ do , myModifiedAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"}) } -> addr1 == addr2 -- The keys should match. _ -> False) + + itDb "can be used in a left join" $ do + setup + records <- select $ do + from $ table @User `leftJoin` myRecordQuery + `on` do + \(u :& myRecord) -> + just (castString @String @Text (u ^. UserName)) ==. + (getField @"myName" myRecord) + pure () + + itDb "casing breaks stuff?" $ do + setup + records <- select $ do + u :& maybeMyRecord <- from $ table @User `leftJoin` myRecordQuery + `on` do + \(u :& myRecord) -> + just (castString @String @Text (u ^. UserName)) ==. + (getField @"myName" myRecord) + &&. val False + + pure (u :& maybeMyRecord) + pure () +