Add support for EXISTS and NOT EXISTS.
This commit is contained in:
parent
927bc831f8
commit
4769d30b18
@ -24,6 +24,7 @@ module Database.Esqueleto
|
|||||||
, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
|
, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
|
||||||
, (+.), (-.), (/.), (*.)
|
, (+.), (-.), (/.), (*.)
|
||||||
, like, (%), concat_, (++.)
|
, like, (%), concat_, (++.)
|
||||||
|
, exists, notExists
|
||||||
, set, (=.), (+=.), (-=.), (*=.), (/=.) )
|
, set, (=.), (+=.), (-=.), (*=.), (/=.) )
|
||||||
, from
|
, from
|
||||||
, Value(..)
|
, Value(..)
|
||||||
|
|||||||
@ -240,6 +240,21 @@ class (Functor query, Applicative query, Monad query) =>
|
|||||||
-- Supported by SQLite and PostgreSQL.
|
-- Supported by SQLite and PostgreSQL.
|
||||||
(++.) :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value s)
|
(++.) :: (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
|
-- | @SET@ clause used on @UPDATE@s. Note that while it's not
|
||||||
-- a type error to use this function on a @SELECT@, it will
|
-- a type error to use this function on a @SELECT@, it will
|
||||||
-- most certainly result in a runtime error.
|
-- most certainly result in a runtime error.
|
||||||
|
|||||||
@ -324,6 +324,9 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
|
|||||||
concat_ = unsafeSqlFunction "CONCAT"
|
concat_ = unsafeSqlFunction "CONCAT"
|
||||||
(++.) = unsafeSqlBinOp " || "
|
(++.) = unsafeSqlBinOp " || "
|
||||||
|
|
||||||
|
exists = unsafeSqlFunction "EXISTS " . existsHelper
|
||||||
|
notExists = unsafeSqlFunction "NOT EXISTS " . existsHelper
|
||||||
|
|
||||||
set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds }
|
set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds }
|
||||||
where
|
where
|
||||||
apply (ESet f) = SetClause (f ent)
|
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 :: Connection -> DBName -> TLB.Builder
|
||||||
fromDBName conn = TLB.fromText . escapeName conn
|
fromDBName conn = TLB.fromText . escapeName conn
|
||||||
|
|
||||||
|
existsHelper :: SqlQuery () -> SqlExpr (Value a)
|
||||||
|
existsHelper =
|
||||||
|
ERaw Parens .
|
||||||
|
flip (toRawSql SELECT) .
|
||||||
|
(>> return (val True :: SqlExpr (Value Bool)))
|
||||||
|
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
|||||||
32
test/Test.hs
32
test/Test.hs
@ -463,6 +463,38 @@ main = do
|
|||||||
, Entity p3k p3 { personAge = Just 7 }
|
, Entity p3k p3 { personAge = Just 7 }
|
||||||
, Entity p2k p2 { personAge = Just 0 } ]
|
, 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 ]
|
||||||
|
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user