diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index b9c4479..6705224 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -24,6 +24,7 @@ module Database.Esqueleto , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) , (+.), (-.), (/.), (*.) , like, (%), concat_, (++.) + , exists, notExists , set, (=.), (+=.), (-=.), (*=.), (/=.) ) , from , Value(..) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 503c15e..410b9c2 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -240,6 +240,21 @@ class (Functor query, Applicative query, Monad query) => -- Supported by SQLite and PostgreSQL. (++.) :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value s) + -- | @EXISTS@ operator. For example: + -- + -- @ + -- select $ + -- from $ \person -> do + -- where_ $ exists $ + -- from $ \post -> do + -- where_ (post ^. BlogPostAuthorId ==. person ^. PersonId) + -- return person + -- @ + exists :: query () -> expr (Value Bool) + + -- | @NOT EXISTS@ operator. + notExists :: query () -> expr (Value Bool) + -- | @SET@ clause used on @UPDATE@s. Note that while it's not -- a type error to use this function on a @SELECT@, it will -- most certainly result in a runtime error. diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 492a12d..b523ff5 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -324,6 +324,9 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where concat_ = unsafeSqlFunction "CONCAT" (++.) = unsafeSqlBinOp " || " + exists = unsafeSqlFunction "EXISTS " . existsHelper + notExists = unsafeSqlFunction "NOT EXISTS " . existsHelper + set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds } where apply (ESet f) = SetClause (f ent) @@ -356,6 +359,12 @@ sub mode query = ERaw Parens $ \conn -> first parens (toRawSql mode conn query) fromDBName :: Connection -> DBName -> TLB.Builder fromDBName conn = TLB.fromText . escapeName conn +existsHelper :: SqlQuery () -> SqlExpr (Value a) +existsHelper = + ERaw Parens . + flip (toRawSql SELECT) . + (>> return (val True :: SqlExpr (Value Bool))) + ---------------------------------------------------------------------- diff --git a/test/Test.hs b/test/Test.hs index ba1f90f..10cf961 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -463,6 +463,38 @@ main = do , Entity p3k p3 { personAge = Just 7 } , Entity p2k p2 { personAge = Just 0 } ] + describe "lists of values" $ do + it "EXISTS works for subList_select" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + p3k <- insert p3 + _ <- insert (BlogPost "" p1k) + _ <- insert (BlogPost "" p3k) + ret <- select $ + from $ \p -> do + where_ $ exists $ + from $ \bp -> do + where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId) + return p + liftIO $ ret `shouldBe` [ Entity p1k p1 + , Entity p3k p3 ] + + it "EXISTS works for subList_select" $ + run $ do + p1k <- insert p1 + p2k <- insert p2 + p3k <- insert p3 + _ <- insert (BlogPost "" p1k) + _ <- insert (BlogPost "" p3k) + ret <- select $ + from $ \p -> do + where_ $ notExists $ + from $ \bp -> do + where_ (bp ^. BlogPostAuthorId ==. p ^. PersonId) + return p + liftIO $ ret `shouldBe` [ Entity p2k p2 ] + ----------------------------------------------------------------------