Fix distinctOn

changelog.md

@@ -1,3 +1,10 @@
+3.6.0.0 (unreleased)
+=======
+- @parsonsmatt
+    - [#287](https://github.com/bitemyapp/esqueleto/pull/278)
+        - Deprecate `distinctOn` and `distinctOnOrderBy`. Use the variants
+          defined in `PostgreSQL` module instead.
+
 3.5.3.0
 =======
 - @m4dc4p

examples/Main.hs

@@ -19,30 +19,21 @@ module Main
     ) where
 
 import Blog
-import Control.Monad (void)
-import Control.Monad (forM_)
+import Control.Monad (forM_, void)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Logger (MonadLogger, MonadLoggerIO)
 import Control.Monad.Reader (MonadReader(..), runReaderT)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Monoid ((<>))
-import Database.Esqueleto
+import Database.Esqueleto.Legacy
 import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn)
+import qualified Database.Persist.Sql as Persistent
 import Database.Persist.TH
-       ( AtLeastOneUniqueKey(..)
-       , OnlyOneUniqueKey(..)
-       , mkDeleteCascade
-       , mkMigrate
-       , mkPersist
-       , persistLowerCase
-       , share
-       , sqlSettings
-       )
+       (mkMigrate, mkPersist, persistLowerCase, share, sqlSettings)
 
 
 share [ mkPersist sqlSettings
-      , mkDeleteCascade sqlSettings
       , mkMigrate "migrateAll"] [persistLowerCase|
   Person
     name String
@@ -150,7 +141,7 @@ deleteYoungsters = do
     from $ \p -> do
     where_ (p ^. PersonAge <. just (val 14))
     pure p
-  forM_ youngsters (deleteCascade . entityKey)
+  forM_ youngsters (Persistent.delete . entityKey)
 
 
 insertBlogPosts :: (MonadIO m, MonadLogger m)

src/Database/Esqueleto/Internal/Internal.hs

@@ -341,6 +341,8 @@ distinct act = Q (W.tell mempty { sdDistinctClause = DistinctStandard }) >> act
 distinctOn :: [SqlExpr DistinctOn] -> SqlQuery a -> SqlQuery a
 distinctOn exprs act = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs }) >> act
 
+{-# DEPRECATED distinctOn "This function is deprecated, as it is only supported in Postgresql. Please use the variant in `Database.Esqueleto.PostgreSQL` instead." #-}
+
 -- | Erase an SqlExpression's type so that it's suitable to
 -- be used by 'distinctOn'.
 --
@@ -380,6 +382,8 @@ distinctOnOrderBy exprs act =
               $ TLB.toLazyText b
             , vals )
 
+{-# DEPRECATED distinctOnOrderBy "This function is deprecated, as it is only supported in Postgresql. Please use the function defined in `Database.Esqueleto.PostgreSQL` instead." #-}
+
 -- | @ORDER BY random()@ clause.
 --
 -- @since 1.3.10

src/Database/Esqueleto/PostgreSQL.hs

@@ -29,6 +29,8 @@ module Database.Esqueleto.PostgreSQL
     , insertSelectWithConflictCount
     , filterWhere
     , values
+    , distinctOn
+    , distinctOnOrderBy
     -- * Internal
     , unsafeSqlAggregateFunction
     ) where
@@ -41,19 +43,22 @@ import Control.Exception (throw)
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(..))
 import qualified Control.Monad.Trans.Reader as R
+import qualified Control.Monad.Trans.Writer as W
 import Data.Int (Int64)
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
 import Data.Proxy (Proxy(..))
 import qualified Data.Text.Internal.Builder as TLB
 import qualified Data.Text.Lazy as TL
 import Data.Time.Clock (UTCTime)
+import Database.Esqueleto.Internal.Internal hiding
+       (distinctOn, distinctOnOrderBy, random_)
+
 import qualified Database.Esqueleto.Experimental as Ex
 import qualified Database.Esqueleto.Experimental.From as Ex
-import Database.Esqueleto.Internal.Internal hiding (random_)
 import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
-import Database.Persist.Class (OnlyOneUniqueKey)
 import Database.Persist (ConstraintNameDB(..), EntityNameDB(..))
+import Database.Persist.Class (OnlyOneUniqueKey)
 import Database.Persist.SqlBackend
 
 -- | (@random()@) Split out into database specific modules
@@ -63,6 +68,68 @@ import Database.Persist.SqlBackend
 random_ :: (PersistField a, Num a) => SqlExpr (Value a)
 random_ = unsafeSqlValue "RANDOM()"
 
+-- | @DISTINCT ON@.  Change the current @SELECT@ into
+-- @SELECT DISTINCT ON (SqlExpressions)@.  For example:
+--
+-- @
+-- select $ do
+--   foo <- 'from' $ table \@Foo
+--   'distinctOn' ['don' (foo ^. FooName), 'don' (foo ^. FooState)]
+--   pure foo
+-- @
+--
+-- You can also chain different calls to 'distinctOn'.  The
+-- above is equivalent to:
+--
+-- @
+-- select $ do
+--   foo <- 'from' $ table \@Foo
+--   'distinctOn' ['don' (foo ^. FooName)]
+--   'distinctOn' ['don' (foo ^. FooState)]
+--   pure foo
+-- @
+--
+-- Each call to 'distinctOn' adds more SqlExpressions.  Calls to
+-- 'distinctOn' override any calls to 'distinct'.
+--
+-- Note that PostgreSQL requires the SqlExpressions on @DISTINCT
+-- ON@ to be the first ones to appear on a @ORDER BY@.  This is
+-- not managed automatically by esqueleto, keeping its spirit
+-- of trying to be close to raw SQL.
+--
+-- @since 3.6.0
+distinctOn :: [SqlExpr DistinctOn] -> SqlQuery ()
+distinctOn exprs = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs })
+
+-- | A convenience function that calls both 'distinctOn' and
+-- 'orderBy'.  In other words,
+--
+-- @
+-- 'distinctOnOrderBy' [asc foo, desc bar, desc quux]
+-- @
+--
+-- is the same as:
+--
+-- @
+-- 'distinctOn' [don foo, don  bar, don  quux]
+-- 'orderBy'  [asc foo, desc bar, desc quux]
+--   ...
+-- @
+--
+-- @since 3.6.0
+distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery ()
+distinctOnOrderBy exprs = do
+    distinctOn (toDistinctOn <$> exprs)
+    orderBy exprs
+  where
+    toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
+    toDistinctOn (ERaw m f) = ERaw m $ \p info ->
+        let (b, vals) = f p info
+        in  ( TLB.fromLazyText
+              $ TL.replace " DESC" ""
+              $ TL.replace " ASC" ""
+              $ TLB.toLazyText b
+            , vals )
 -- | Empty array literal. (@val []@) does unfortunately not work
 emptyArray :: SqlExpr (Value [a])
 emptyArray = unsafeSqlValue "'{}'"