Support for IN and NOT IN.

src/Database/Esqueleto.hs

@@ -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(..)

src/Database/Esqueleto/Internal/Language.hs

@@ -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

src/Database/Esqueleto/Internal/Sql.hs

@@ -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
+-- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to
--- another 'SqlExpr (Value b)'.  You should /not/ use this
+-- 'SqlExpr (Value b)'.  You should /not/ use this function
--- function unless you know what you're doing!
+-- 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
+
+
 ----------------------------------------------------------------------
 
 

test/Test.hs

@@ -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