From 4dc58ec1b82551ba054be8fc07e0b8cb51950d2a Mon Sep 17 00:00:00 2001 From: belevy Date: Sun, 17 Jan 2021 18:26:00 -0600 Subject: [PATCH] Remove EList and EEmptyList; ERaw is now technically possible in each case since it is generalized to all --- src/Database/Esqueleto/Internal/Internal.hs | 36 ++++++++++----------- test/Common/Test.hs | 15 +++++---- 2 files changed, 27 insertions(+), 24 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index f57c5d0..8460c73 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -24,6 +24,7 @@ module Database.Esqueleto.Internal.Internal where import Control.Applicative ((<|>)) +import Data.Coerce (coerce) import Control.Arrow (first, (***)) import Control.Exception (Exception, throw, throwIO) import Control.Monad (MonadPlus(..), guard, void) @@ -887,12 +888,13 @@ castString = veryUnsafeCoerceSqlExprValue -- | Execute a subquery @SELECT@ in an SqlExpression. Returns a -- list of values. subList_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a) -subList_select = EList . sub_select +subList_select query = ERaw noMeta $ \_ info -> first parens $ toRawSql SELECT info query + -- | Lift a list of constant value from Haskell-land to the query. valList :: PersistField typ => [typ] -> SqlExpr (ValueList typ) -valList [] = EEmptyList -valList vals = EList $ ERaw noMeta $ \p -> const (parensM p (uncommas ("?" <$ vals)), map toPersistValue vals ) +valList [] = ERaw noMeta $ \_ _ -> ("()", []) +valList vals = ERaw noMeta $ \p -> const (parensM p (uncommas ("?" <$ vals)), map toPersistValue vals ) -- | Same as 'just' but for 'ValueList'. Most of the time you -- won't need it, though, because you can use 'just' from @@ -900,8 +902,7 @@ valList vals = EList $ ERaw noMeta $ \p -> const (parensM p (uncommas ("?" <$ va -- -- @since 2.2.12 justList :: SqlExpr (ValueList typ) -> SqlExpr (ValueList (Maybe typ)) -justList EEmptyList = EEmptyList -justList (EList v) = EList (just v) +justList (ERaw m f) = ERaw m f -- | @IN@ operator. For example if you want to select all @Person@s by a list -- of IDs: @@ -923,11 +924,19 @@ justList (EList v) = EList (just v) -- -- Where @personIds@ is of type @[Key Person]@. in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) -v `in_` e = ifNotEmptyList e False $ unsafeSqlBinOp " IN " v (veryUnsafeCoerceSqlExprValueList e) +(ERaw _ v) `in_` (ERaw _ list) = + ERaw noMeta $ \p info -> + let (b1, vals1) = v Parens info + (b2, vals2) = list Parens info + in (b1 <> " IN " <> b2, vals1 <> vals2) -- | @NOT IN@ operator. notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) -v `notIn` e = ifNotEmptyList e True $ unsafeSqlBinOp " NOT IN " v (veryUnsafeCoerceSqlExprValueList e) +(ERaw _ v) `notIn` (ERaw _ list) = + ERaw noMeta $ \p info -> + let (b1, vals1) = v Parens info + (b2, vals2) = list Parens info + in (b1 <> " NOT IN " <> b2, vals1 <> vals2) -- | @EXISTS@ operator. For example: -- @@ -2034,7 +2043,7 @@ data SqlExpr a where -- connection (mainly for escaping names) and returns both an -- string ('TLB.Builder') and a list of values to be -- interpolated by the SQL backend. - ERaw :: SqlExprMeta -> (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) + ERaw :: SqlExprMeta -> (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr a -- A composite key. -- @@ -2077,10 +2086,6 @@ data SqlExpr a where -- impossible, e.g., for 'val' to disambiguate between these -- uses. - -- 'EList' and 'EEmptyList' are used by list operators. - EList :: SqlExpr (Value a) -> SqlExpr (ValueList a) - EEmptyList :: SqlExpr (ValueList a) - -- A 'SqlExpr' accepted only by 'orderBy'. EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy @@ -2141,10 +2146,6 @@ existsHelper = sub SELECT . (>> return true) true :: SqlExpr (Value Bool) true = val True -ifNotEmptyList :: SqlExpr (ValueList a) -> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) -ifNotEmptyList EEmptyList b _ = val b -ifNotEmptyList (EList _) _ x = x - -- | (Internal) Create a case statement. -- -- Since: 2.1.1 @@ -2459,8 +2460,7 @@ veryUnsafeCoerceSqlExprValue (ERaw m f) = ERaw m f -- | (Internal) Coerce a value's type from 'SqlExpr (ValueList -- a)' to 'SqlExpr (Value a)'. Does not work with empty lists. veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a) -veryUnsafeCoerceSqlExprValueList (EList v) = v -veryUnsafeCoerceSqlExprValueList EEmptyList = throw (UnexpectedCaseErr EmptySqlExprValueList) +veryUnsafeCoerceSqlExprValueList (ERaw m f) = ERaw m f ---------------------------------------------------------------------- diff --git a/test/Common/Test.hs b/test/Common/Test.hs index 1dcb918..45fb92a 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -389,7 +389,8 @@ testSubSelect run = do v `shouldBe` [Value 1] describe "subSelectList" $ do - it "is safe on empty databases as well as good databases" $ do + it "is safe on empty databases as well as good databases" $ run $ do + liftIO $ putStrLn "hello" let query = from $ \n -> do where_ $ n ^. NumbersInt `in_` do @@ -398,16 +399,18 @@ testSubSelect run = do where_ $ n' ^. NumbersInt >=. val 3 pure (n' ^. NumbersInt) pure n - - empty <- run $ do + empty <- do + liftIO . print =<< renderQuerySelect query select query + liftIO $ putStrLn "goodbye" - full <- run $ do + full <- do setup select query - empty `shouldBe` [] - full `shouldSatisfy` (not . null) + liftIO $ do + empty `shouldBe` [] + full `shouldSatisfy` (not . null) describe "subSelectMaybe" $ do it "is equivalent to joinV . subSelect" $ do