haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Support for IN and NOT IN.

Browse Source
This commit is contained in:
Felipe Lessa 2012-11-28 18:23:52 -02:00
parent 4769d30b18
commit 5514f68994
4 changed files with 98 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Database/Esqueleto.hs
View File

@ -24,10 +24,12 @@ module Database.Esqueleto
, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
, (+.), (-.), (/.), (*.)
, like, (%), concat_, (++.)
, exists, notExists
, subList_select, subList_selectDistinct, valList
, in_, notIn, exists, notExists
, set, (=.), (+=.), (-=.), (*=.), (/=.) )
, from
, Value(..)
, ValueList(..)
, OrderBy
-- ** Joins
, InnerJoin(..)

30
src/Database/Esqueleto/Internal/Language.hs
View File

@ -16,6 +16,7 @@ module Database.Esqueleto.Internal.Language
Esqueleto(..)
, from
, Value(..)
, ValueList(..)
, SomeValue(..)
, ToSomeValues(..)
, InnerJoin(..)
@ -173,10 +174,12 @@ class (Functor query, Applicative query, Monad query) =>
-- | @OFFSET@. Usually used with 'limit'.
offset :: Int64 -> query ()
-- | Execute a subquery @SELECT@ in an expression.
-- | Execute a subquery @SELECT@ in an expression. Returns a
-- simple value so should be used only when the @SELECT@ query
-- is guaranteed to return just one row.
sub_select :: PersistField a => query (expr (Value a)) -> expr (Value a)
-- | Execute a subquery @SELECT DISTINCT@ in an expression.
-- | Same as 'sub_select' but using @SELECT DISTINCT@.
sub_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (Value a)
-- | Project a field of an entity.
@ -240,6 +243,22 @@ 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)
-- | Execute a subquery @SELECT@ in an expression. Returns a
-- list of values.
subList_select :: PersistField a => query (expr (Value a)) -> expr (ValueList a)
-- | Same as 'sublist_select' but using @SELECT DISTINCT@.
subList_selectDistinct :: PersistField a => query (expr (Value a)) -> expr (ValueList a)
-- | Lift a list of constant value from Haskell-land to the query.
valList :: PersistField typ => [typ] -> expr (ValueList typ)
-- | @IN@ operator.
in_ :: PersistField typ => expr (Value typ) -> expr (ValueList typ) -> expr (Value Bool)
-- | @NOT IN@ operator.
notIn :: PersistField typ => expr (Value typ) -> expr (ValueList typ) -> expr (Value Bool)
-- | @EXISTS@ operator. For example:
--
-- @
@ -283,6 +302,13 @@ data Value a = Value a deriving (Eq, Ord, Show, Typeable)
-- Note: because of GHC bug #6124 we use @data@ instead of @newtype@.
-- | A list of single values. There's a limited set of funcitons
-- able to work with this data type (such as 'subList_select',
-- 'valList', 'in_' and 'exists').
data ValueList a = ValueList a deriving (Eq, Ord, Show, Typeable)
-- Note: because of GHC bug #6124 we use @data@ instead of @newtype@.
-- | A wrapper type for for any @expr (Value a)@ for all a.
data SomeValue expr where
SomeValue :: Esqueleto query expr backend => expr (Value a) -> SomeValue expr

27
src/Database/Esqueleto/Internal/Sql.hs
View File

@ -35,7 +35,7 @@ module Database.Esqueleto.Internal.Sql
, veryUnsafeCoerceSqlExprValue
) where
import Control.Applicative (Applicative(..), (<$>))
import Control.Applicative (Applicative(..), (<$>), (<$))
import Control.Arrow ((***), first)
import Control.Exception (throw, throwIO)
import Control.Monad ((>=>), ap, MonadPlus(..))
@ -228,6 +228,7 @@ data SqlExpr a where
EEntity :: Ident -> SqlExpr (Entity val)
EMaybe :: SqlExpr a -> SqlExpr (Maybe a)
ERaw :: NeedParens -> (Connection -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)
EList :: SqlExpr (Value a) -> SqlExpr (ValueList a)
EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)
EPreprocessedFrom :: a -> FromClause -> SqlExpr (PreprocessedFrom a)
@ -324,6 +325,15 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
concat_ = unsafeSqlFunction "CONCAT"
(++.) = unsafeSqlBinOp " || "
subList_select = EList . sub_select
subList_selectDistinct = EList . sub_selectDistinct
valList vals = EList $ ERaw Parens $ const ( uncommas ("?" <$ vals)
, map toPersistValue vals )
v `in_` e = unsafeSqlBinOp " IN " v (veryUnsafeCoerceSqlExprValueList e)
v `notIn` e = unsafeSqlBinOp " NOT IN " v (veryUnsafeCoerceSqlExprValueList e)
exists = unsafeSqlFunction "EXISTS " . existsHelper
notExists = unsafeSqlFunction "NOT EXISTS " . existsHelper
@ -341,7 +351,6 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
instance ToSomeValues SqlExpr (SqlExpr (Value a)) where
toSomeValues a = [SomeValue a]
fieldName :: (PersistEntity val, PersistField typ)
=> Connection -> EntityField val typ -> TLB.Builder
fieldName conn = fromDBName conn . fieldDB . persistFieldDef
@ -354,7 +363,7 @@ setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent)
where name = ERaw Never $ \conn -> (fieldName conn field, mempty)
sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub mode query = ERaw Parens $ \conn -> first parens (toRawSql mode conn query)
sub mode query = ERaw Parens $ \conn -> toRawSql mode conn query
fromDBName :: Connection -> DBName -> TLB.Builder
fromDBName conn = TLB.fromText . escapeName conn
@ -432,13 +441,19 @@ instance ( UnsafeSqlFunctionArgument a
toArgList = toArgList . from4
-- | (Internal) Coerce a type of a 'SqlExpr (Value a)' into
-- another 'SqlExpr (Value b)'. You should /not/ use this
-- function unless you know what you're doing!
-- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to
-- 'SqlExpr (Value b)'. You should /not/ use this function
-- unless you know what you're doing!
veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f
-- | (Internal) Coerce a value's type from 'SqlExpr (ValueList
-- a)' to 'SqlExpr (Value a)'.
veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a)
veryUnsafeCoerceSqlExprValueList (EList v) = v
----------------------------------------------------------------------

47
test/Test.hs
View File

@ -464,6 +464,51 @@ main = do
, Entity p2k p2 { personAge = Just 0 } ]
describe "lists of values" $ do
it "IN works for valList" $
run $ do
p1k <- insert p1
p2k <- insert p2
p3k <- insert p3
ret <- select $
from $ \p -> do
where_ (p ^. PersonName `in_` valList (personName <$> [p1, p2]))
return p
liftIO $ ret `shouldBe` [ Entity p1k p1
, Entity p2k p2 ]
it "IN 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
let subquery =
from $ \bp ->
return (bp ^. BlogPostAuthorId)
where_ (p ^. PersonId `in_` subList_select subquery)
return p
liftIO $ ret `shouldBe` [ Entity p1k p1
, Entity p3k p3 ]
it "NOT IN 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
let subquery =
from $ \bp ->
return (bp ^. BlogPostAuthorId)
where_ (p ^. PersonId `notIn` subList_select subquery)
return p
liftIO $ ret `shouldBe` [ Entity p2k p2 ]
it "EXISTS works for subList_select" $
run $ do
p1k <- insert p1
@ -518,7 +563,7 @@ run =
verbose :: Bool
verbose = False
verbose = True
run_worker :: RunDbMonad m => SqlPersist (C.ResourceT m) a -> m a