diff --git a/changelog.md b/changelog.md index 95f97bc..4b706ae 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,10 @@ -3.2.0 (unreleased) -======= +(unreleased) 3.2.0 +======== +- @parsonsmatt + - [#153](https://github.com/bitemyapp/esqueleto/pull/153): Deprecate + `sub_select` and introduce `subSelect`, `subSelectMaybe`, and + `subSelectUnsafe`. - @parsonsmatt - [#156](https://github.com/bitemyapp/esqueleto/pull/156): Remove the restriction that `on` clauses must appear in reverse order to the joining diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 3230a7a..1840394 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -53,6 +53,12 @@ module Database.Esqueleto , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) , case_, toBaseId + , subSelect + , subSelectMaybe + , subSelectCount + , subSelectForeign + , subSelectList + , subSelectUnsafe , ToBaseId(..) , when_ , then_ diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 0e14f55..16bbc6a 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -352,12 +352,149 @@ having expr = Q $ W.tell mempty { sdHavingClause = Where expr } locking :: LockingKind -> SqlQuery () locking kind = Q $ W.tell mempty { sdLockingClause = Monoid.Last (Just kind) } +{-# + DEPRECATED + sub_select + "sub_select \n \ +sub_select is an unsafe function to use. If used with a SqlQuery that \n \ +returns 0 results, then it may return NULL despite not mentioning Maybe \n \ +in the return type. If it returns more than 1 result, then it will throw a \n \ +SQL error.\n\n Instead, consider using one of the following alternatives: \n \ +- subSelect: attaches a LIMIT 1 and the Maybe return type, totally safe. \n \ +- subSelectMaybe: Attaches a LIMIT 1, useful for a query that already \n \ + has a Maybe in the return type. \n \ +- subSelectCount: Performs a count of the query - this is always safe. \n \ +- subSelectUnsafe: Performs no checks or guarantees. Safe to use with \n \ + countRows and friends." + #-} -- | Execute a subquery @SELECT@ in an SqlExpression. Returns a -- simple value so should be used only when the @SELECT@ query -- is guaranteed to return just one row. +-- +-- Deprecated in 3.2.0. sub_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) sub_select = sub SELECT +-- | Execute a subquery @SELECT@ in a 'SqlExpr'. The query passed to this +-- function will only return a single result - it has a @LIMIT 1@ passed in to +-- the query to make it safe, and the return type is 'Maybe' to indicate that +-- the subquery might result in 0 rows. +-- +-- If you find yourself writing @'joinV' . 'subSelect'@, then consider using +-- 'subSelectMaybe'. +-- +-- If you're performing a 'countRows', then you can use 'subSelectCount' which +-- is safe. +-- +-- If you know that the subquery will always return exactly one row (eg +-- a foreign key constraint guarantees that you'll get exactly one row), then +-- consider 'subSelectUnsafe', along with a comment explaining why it is safe. +-- +-- @since 3.2.0 +subSelect + :: PersistField a + => SqlQuery (SqlExpr (Value a)) + -> SqlExpr (Value (Maybe a)) +subSelect query = just (subSelectUnsafe (query <* limit 1)) + +-- | Execute a subquery @SELECT@ in a 'SqlExpr'. This function is a shorthand +-- for the common @'joinV' . 'subSelect'@ idiom, where you are calling +-- 'subSelect' on an expression that would be 'Maybe' already. +-- +-- As an example, you would use this function when calling 'sum_' or 'max_', +-- which have 'Maybe' in the result type (for a 0 row query). +-- +-- @since 3.2.0 +subSelectMaybe + :: PersistField a + => SqlQuery (SqlExpr (Value (Maybe a))) + -> SqlExpr (Value (Maybe a)) +subSelectMaybe = joinV . subSelect + +-- | Performs a @COUNT@ of the given query in a @subSelect@ manner. This is +-- always guaranteed to return a result value, and is completely safe. +-- +-- @since 3.2.0 +subSelectCount + :: (Num a, PersistField a) + => SqlQuery ignored + -> SqlExpr (Value a) +subSelectCount query = do + subSelectUnsafe $ do + _ <- query + pure countRows + +-- | Execute a subquery @SELECT@ in a 'SqlExpr' that returns a list. This is an +-- alias for 'subList_select' and is provided for symmetry with the other safe +-- subselect functions. +-- +-- @since 3.2.0 +subSelectList + :: PersistField a + => SqlQuery (SqlExpr (Value a)) + -> SqlExpr (ValueList a) +subSelectList = subList_select + +-- | Performs a sub-select using the given foreign key on the entity. This is +-- useful to extract values that are known to be present by the database schema. +-- +-- As an example, consider the following persistent definition: +-- +-- @ +-- User +-- profile ProfileId +-- +-- Profile +-- name Text +-- @ +-- +-- The following query will return the name of the user. +-- +-- @ +-- getUserWithName = +-- 'select' $ +-- 'from' $ \user -> +-- 'pure' (user, 'subSelectForeign' user UserProfile (^. ProfileName) +-- @ +-- +-- @since 3.2.0 +subSelectForeign + :: + ( BackendCompatible SqlBackend (PersistEntityBackend val1) + , PersistEntity val1, PersistEntity val2, PersistField a + ) + => SqlExpr (Entity val2) + -- ^ An expression representing the table you have access to now. + -> EntityField val2 (Key val1) + -- ^ The foreign key field on the table. + -> (SqlExpr (Entity val1) -> SqlExpr (Value a)) + -- ^ A function to extract a value from the foreign reference table. + -> SqlExpr (Value a) +subSelectForeign expr foreignKey with = + subSelectUnsafe $ + from $ \table -> do + where_ $ expr ^. foreignKey ==. table ^. persistIdField + pure (with table) + +-- | Execute a subquery @SELECT@ in a 'SqlExpr'. This function is unsafe, +-- because it can throw runtime exceptions in two cases: +-- +-- 1. If the query passed has 0 result rows, then it will return a @NULL@ value. +-- The @persistent@ parsing operations will fail on an unexpected @NULL@. +-- 2. If the query passed returns more than one row, then the SQL engine will +-- fail with an error like "More than one row returned by a subquery used as +-- an expression". +-- +-- This function is safe if you guarantee that exactly one row will be returned, +-- or if the result already has a 'Maybe' type for some reason. +-- +-- For variants with the safety encoded already, see 'subSelect' and +-- 'subSelectMaybe'. For the most common safe use of this, see 'subSelectCount'. +-- +-- @since 3.2.0 +subSelectUnsafe :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) +subSelectUnsafe = sub SELECT + -- | Project a field of an entity. (^.) :: forall typ val. (PersistEntity val, PersistField typ) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index dfa4985..a6fe103 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -56,6 +56,12 @@ module Database.Esqueleto.Internal.Language , in_, notIn, exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) , case_, toBaseId, (<#), (<&>) + , subSelect + , subSelectMaybe + , subSelectCount + , subSelectList + , subSelectForeign + , subSelectUnsafe ) where import Database.Esqueleto.Internal.PersistentImport diff --git a/test/Common/Test.hs b/test/Common/Test.hs index 8bef42d..806e0f1 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -1,7 +1,8 @@ -{-# OPTIONS_GHC -fno-warn-unused-binds #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# LANGUAGE ConstraintKinds , CPP + , TypeApplications , PartialTypeSignatures , UndecidableInstances , EmptyDataDecls @@ -176,6 +177,7 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| Numbers int Int double Double + deriving Eq Show JoinOne name String @@ -287,6 +289,179 @@ testSelect run = do ret <- select $ return nothing liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] +testSubSelect :: Run -> Spec +testSubSelect run = do + let + setup :: MonadIO m => SqlPersistT m () + setup = do + _ <- insert $ Numbers 1 2 + _ <- insert $ Numbers 2 4 + _ <- insert $ Numbers 3 5 + _ <- insert $ Numbers 6 7 + pure () + describe "subSelect" $ do + it "is safe for queries that may return multiple results" $ do + let + query = + from $ \n -> do + orderBy [asc (n ^. NumbersInt)] + pure (n ^. NumbersInt) + res <- run $ do + setup + select $ pure $ subSelect query + res `shouldBe` [Value (Just 1)] + + eres <- try $ run $ do + setup + select $ pure $ sub_select query + case eres of + Left (SomeException _) -> + -- We should receive an exception, but the different database + -- libraries throw different exceptions. Hooray. + pure () + Right v -> + -- This shouldn't happen, but in sqlite land, many things are + -- possible. + v `shouldBe` [Value 1] + + it "is safe for queries that may not return anything" $ do + let + query = + from $ \n -> do + orderBy [asc (n ^. NumbersInt)] + limit 1 + pure (n ^. NumbersInt) + res <- run $ select $ pure $ subSelect query + res `shouldBe` [Value Nothing] + + eres <- try $ run $ do + setup + select $ pure $ sub_select query + + case eres of + Left (_ :: PersistException) -> + -- We expect to receive this exception. However, sqlite evidently has + -- no problems with it, so we can't *require* that the exception is + -- thrown. Sigh. + pure () + Right v -> + -- This shouldn't happen, but in sqlite land, many things are + -- possible. + v `shouldBe` [Value 1] + + describe "subSelectList" $ do + it "is safe on empty databases as well as good databases" $ do + let + query = + from $ \n -> do + where_ $ n ^. NumbersInt `in_` do + subSelectList $ + from $ \n' -> do + where_ $ n' ^. NumbersInt >=. val 3 + pure (n' ^. NumbersInt) + pure n + + empty <- run $ do + select query + + full <- run $ do + setup + select query + + empty `shouldBe` [] + full `shouldSatisfy` (not . null) + + describe "subSelectMaybe" $ do + it "is equivalent to joinV . subSelect" $ do + let + query + :: ( SqlQuery (SqlExpr (Value (Maybe Int))) + -> SqlExpr (Value (Maybe Int)) + ) + -> SqlQuery (SqlExpr (Value (Maybe Int))) + query selector = + from $ \n -> do + pure $ + selector $ + from $ \n' -> do + where_ $ n' ^. NumbersDouble >=. n ^. NumbersDouble + pure (max_ (n' ^. NumbersInt)) + + a <- run $ do + setup + select (query subSelectMaybe) + b <- run $ do + setup + select (query (joinV . subSelect)) + a `shouldBe` b + + describe "subSelectCount" $ do + it "is a safe way to do a countRows" $ do + xs0 <- run $ do + setup + select $ + from $ \n -> do + pure $ (,) n $ + subSelectCount @Int $ + from $ \n' -> do + where_ $ n' ^. NumbersInt >=. n ^. NumbersInt + + xs1 <- run $ do + setup + select $ + from $ \n -> do + pure $ (,) n $ + subSelectUnsafe $ + from $ \n' -> do + where_ $ n' ^. NumbersInt >=. n ^. NumbersInt + pure (countRows :: SqlExpr (Value Int)) + + let getter (Entity _ a, b) = (a, b) + map getter xs0 `shouldBe` map getter xs1 + + describe "subSelectUnsafe" $ do + it "throws exceptions on multiple results" $ do + eres <- try $ run $ do + setup + bad <- select $ + from $ \n -> do + pure $ (,) (n ^. NumbersInt) $ + subSelectUnsafe $ + from $ \n' -> do + pure (just (n' ^. NumbersDouble)) + good <- select $ + from $ \n -> do + pure $ (,) (n ^. NumbersInt) $ + subSelect $ + from $ \n' -> do + pure (n' ^. NumbersDouble) + pure (bad, good) + case eres of + Left (SomeException _) -> + -- Must use SomeException because the database libraries throw their + -- own errors. + pure () + Right (bad, good) -> do + -- SQLite just takes the first element of the sub-select. lol. + -- + bad `shouldBe` good + + it "throws exceptions on null results" $ do + eres <- try $ run $ do + setup + select $ + from $ \n -> do + pure $ (,) (n ^. NumbersInt) $ + subSelectUnsafe $ + from $ \n' -> do + where_ $ val False + pure (n' ^. NumbersDouble) + case eres of + Left (_ :: PersistException) -> + pure () + Right xs -> + xs `shouldBe` [] + testSelectSource :: Run -> Spec testSelectSource run = do @@ -1986,6 +2161,7 @@ tests :: Run -> Spec tests run = do describe "Tests that are common to all backends" $ do testSelect run + testSubSelect run testSelectSource run testSelectFrom run testSelectJoin run