Allow SELECT DISTINCT queries as well.

src/Database/Esqueleto.hs

@@ -16,7 +16,8 @@
 -- @
 module Database.Esqueleto
   ( -- * @esqueleto@'s Language
-    Esqueleto( where_, on, orderBy, asc, desc, sub, (^.), (?.)
+    Esqueleto( where_, on, orderBy, asc, desc
+             , sub_select, sub_selectDistinct, (^.), (?.)
              , val, isNothing, just, nothing, not_, (==.), (>=.)
              , (>.), (<=.), (<.), (!=.), (&&.), (||.)
              , (+.), (-.), (/.), (*.) )
@@ -34,7 +35,9 @@ module Database.Esqueleto
   , SqlQuery
   , SqlExpr
   , select
+  , selectDistinct
   , selectSource
+  , selectDistinctSource
 
     -- * Re-exports
     -- $reexports

src/Database/Esqueleto/Internal/Language.hs

@@ -120,8 +120,11 @@ class (Functor query, Applicative query, Monad query) =>
   -- | Descending order of this field or expression.
   desc :: PersistField a => expr (Single a) -> expr OrderBy
 
-  -- | Execute a subquery in an expression.
+  -- | Execute a subquery @SELECT@ in an expression.
-  sub  :: PersistField a => query (expr (Single a)) -> expr (Single a)
+  sub_select :: PersistField a => query (expr (Single a)) -> expr (Single a)
+
+  -- | Execute a subquery @SELECT_DISTINCT@ in an expression.
+  sub_selectDistinct :: PersistField a => query (expr (Single a)) -> expr (Single a)
 
   -- | Project a field of an entity.
   (^.) :: (PersistEntity val, PersistField typ) =>

src/Database/Esqueleto/Internal/Sql.hs

@@ -4,13 +4,18 @@ module Database.Esqueleto.Internal.Sql
   , SqlExpr
   , select
   , selectSource
-  , toRawSelectSql
+  , selectDistinct
+  , selectDistinctSource
+  , rawSelectSource
+  , runSource
+  , toRawSql
+  , Mode(..)
   ) where
 
 import Control.Applicative (Applicative(..), (<$>))
 import Control.Arrow ((***), first)
 import Control.Exception (throw, throwIO)
-import Control.Monad (ap, MonadPlus(..))
+import Control.Monad ((>=>), ap, MonadPlus(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Logger (MonadLogger)
 import Control.Monad.Trans.Resource (MonadResourceBase)
@@ -176,7 +181,8 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
   asc  = EOrderBy ASC
   desc = EOrderBy DESC
 
-  sub query = ERaw $ \esc -> first parens (toRawSelectSql esc query)
+  sub_select         = sub SELECT
+  sub_selectDistinct = sub SELECT_DISTINCT
 
   EEntity (I ident) ^. field = ERaw $ \esc -> (ident <> ("." <> name esc field), [])
       where name esc = esc . fieldDB . persistFieldDef
@@ -214,6 +220,8 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
   (/.)  = binop " / "
   (*.)  = binop " * "
 
+sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Single a)) -> SqlExpr (Single a)
+sub mode query = ERaw $ \esc -> first parens (toRawSql mode esc query)
 
 getVal :: SqlExpr (Entity val) -> val
 getVal = error "SqlQuery/getVal: never here"
@@ -231,13 +239,15 @@ binop op (ERaw f1) (ERaw f2) = ERaw f
 binop _ _ _ = error "Esqueleto/Sql/binop: never here (see GHC #6124)"
 
 
--- | Execute an Esqueleto's 'SqlQuery' inside @persistent@'s
+-- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside
--- 'SqlPersist' monad.
+-- @persistent@'s 'SqlPersist' monad.
-selectSource :: ( SqlSelect a r
+rawSelectSource :: ( SqlSelect a r
-                , MonadLogger m
+                   , MonadLogger m
-                , MonadResourceBase m )
+                   , MonadResourceBase m )
-             => SqlQuery a -> SqlPersist m (C.Source (C.ResourceT (SqlPersist m)) r)
+                 => Mode
-selectSource query = src
+                 -> SqlQuery a
+                 -> SqlPersist m (C.Source (C.ResourceT (SqlPersist m)) r)
+rawSelectSource mode query = src
     where
       src = do
         conn <- getConnection
@@ -246,7 +256,7 @@ selectSource query = src
       run conn =
         uncurry withStmt $
         first (TL.toStrict . TLB.toLazyText) $
-        toRawSelectSql (fromDBName conn) query
+        toRawSql mode (fromDBName conn) query
 
       massage = do
         mrow <- C.await
@@ -258,15 +268,51 @@ selectSource query = src
       process = sqlSelectProcessRow
 
 
--- | Execute an Esqueleto's 'SqlQuery' inside @persistent@'s
+-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
--- 'SqlPersist' monad.
+-- 'SqlPersist' monad and return a 'C.Source' of rows.
+selectSource :: ( SqlSelect a r
+                , MonadLogger m
+                , MonadResourceBase m )
+             => SqlQuery a
+             -> SqlPersist m (C.Source (C.ResourceT (SqlPersist m)) r)
+selectSource = rawSelectSource SELECT
+
+
+-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
+-- 'SqlPersist' monad and return a list of rows.
 select :: ( SqlSelect a r
           , MonadLogger m
           , MonadResourceBase m )
        => SqlQuery a -> SqlPersist m [r]
-select query = do
+select = selectSource >=> runSource
-  src <- selectSource query
+
-  C.runResourceT $ src C.$$ CL.consume
+
+-- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside
+-- @persistent@'s 'SqlPersist' monad and return a 'C.Source' of
+-- rows.
+selectDistinctSource
+  :: ( SqlSelect a r
+     , MonadLogger m
+     , MonadResourceBase m )
+  => SqlQuery a
+  -> SqlPersist m (C.Source (C.ResourceT (SqlPersist m)) r)
+selectDistinctSource = rawSelectSource SELECT_DISTINCT
+
+
+-- | Execute an @esqueleto@ @SELECT DISTINCT@ query inside
+-- @persistent@'s 'SqlPersist' monad and return a list of rows.
+selectDistinct :: ( SqlSelect a r
+                  , MonadLogger m
+                  , MonadResourceBase m )
+               => SqlQuery a -> SqlPersist m [r]
+selectDistinct = selectDistinctSource >=> runSource
+
+
+-- | Runs a 'C.Source' of rows.
+runSource :: MonadResourceBase m =>
+             C.Source (C.ResourceT (SqlPersist m)) r
+          -> SqlPersist m [r]
+runSource src = C.runResourceT $ src C.$$ CL.consume
 
 
 -- | Get current database 'Connection'.
@@ -275,19 +321,21 @@ getConnection = SqlPersist R.ask
 
 
 -- | Pretty prints a 'SqlQuery' into a SQL query.
-toRawSelectSql :: SqlSelect a r => Escape -> SqlQuery a -> (TLB.Builder, [PersistValue])
+toRawSql :: SqlSelect a r => Mode -> Escape -> SqlQuery a -> (TLB.Builder, [PersistValue])
-toRawSelectSql esc query =
+toRawSql mode esc query =
   let (ret, SideData fromClauses whereClauses orderByClauses) =
         flip S.evalSupply (idents ()) $
         W.runWriterT $
         unQ query
   in mconcat
-      [ makeSelect  esc ret
+      [ makeSelect  esc mode ret
       , makeFrom    esc fromClauses
       , makeWhere   esc whereClauses
       , makeOrderBy esc orderByClauses
       ]
 
+data Mode = SELECT | SELECT_DISTINCT
+
 
 uncommas :: [TLB.Builder] -> TLB.Builder
 uncommas = mconcat . intersperse ", "
@@ -296,8 +344,12 @@ uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a)
 uncommas' = (uncommas *** mconcat) . unzip
 
 
-makeSelect :: SqlSelect a r => Escape -> a -> (TLB.Builder, [PersistValue])
+makeSelect :: SqlSelect a r => Escape -> Mode -> a -> (TLB.Builder, [PersistValue])
-makeSelect esc ret = first ("SELECT " <>) (sqlSelectCols esc ret)
+makeSelect esc mode ret = first (s <>) (sqlSelectCols esc ret)
+  where
+    s = case mode of
+          SELECT          -> "SELECT "
+          SELECT_DISTINCT -> "SELECT DISTINCT "
 
 
 makeFrom :: Escape -> [FromClause] -> (TLB.Builder, [PersistValue])

test/Test.hs

@@ -320,6 +320,19 @@ main = do
                  return p
           liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
 
+    describe "selectDistinct" $
+      it "works on a simple example" $
+        run $ do
+          p1k <- insert p1
+          let (t1, t2, t3) = ("a", "b", "c")
+          mapM_ (insert . flip BlogPost p1k) [t1, t3, t2, t2, t1]
+          ret <- selectDistinct $
+                 from $ \b -> do
+                 let title = b ^. BlogPostTitle
+                 orderBy [asc title]
+                 return title
+          liftIO $ ret `shouldBe` [ Single t1, Single t2, Single t3 ]
+
 
 ----------------------------------------------------------------------