New convenience function distinctOnOrderBy.

src/Database/Esqueleto.hs

@@ -39,7 +39,7 @@ module Database.Esqueleto
 
     -- * @esqueleto@'s Language
     Esqueleto( where_, on, groupBy, orderBy, rand, asc, desc, limit, offset
-             , distinct, distinctOn, don, having
+             , distinct, distinctOn, don, distinctOnOrderBy, having
              , sub_select, sub_selectDistinct, (^.), (?.)
              , val, isNothing, just, nothing, joinV, countRows, count, not_
              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)

src/Database/Esqueleto/Internal/Language.hs

@@ -241,6 +241,25 @@ class (Functor query, Applicative query, Monad query) =>
   -- /Since: 2.2.4/
   don :: expr (Value a) -> expr DistinctOn
 
+  -- | A convenience function that calls both 'distinctOn' and
+  -- 'orderBy'.  In other words,
+  --
+  -- @
+  -- 'distinctOnOrderBy' [asc foo, desc bar, desc quux] $ do
+  --   ...
+  -- @
+  --
+  -- is the same as:
+  --
+  -- @
+  -- 'distinctOn' [don foo, don  bar, don  quux] $ do
+  --   'orderBy'  [asc foo, desc bar, desc quux]
+  --   ...
+  -- @
+  --
+  -- /Since: 2.2.4/
+  distinctOnOrderBy :: [expr OrderBy] -> query a -> query a
+
   -- | @ORDER BY random()@ clause.
   --
   -- /Since: 1.3.10/

src/Database/Esqueleto/Internal/Sql.hs

@@ -404,6 +404,13 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
   distinct         act = Q (W.tell mempty { sdDistinctClause = DistinctStandard }) >> act
   distinctOn exprs act = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs }) >> act
   don = EDistinctOn
+  distinctOnOrderBy exprs act =
+    distinctOn (toDistinctOn <$> exprs) $ do
+      orderBy exprs
+      act
+    where
+      toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
+      toDistinctOn (EOrderBy _ f) = EDistinctOn f
 
   sub_select         = sub SELECT
   sub_selectDistinct = sub_select . distinct

test/Test.hs

@@ -825,21 +825,32 @@ main = do
                  return bp
           liftIO $ ret `shouldBe` sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC]
 
-      it "works on a slightly less simple example" $ do
+      let slightlyLessSimpleTest q =
-        run $ do
+            run $ do
-          [p1k, p2k, _] <- mapM insert [p1, p2, p3]
+              [p1k, p2k, _] <- mapM insert [p1, p2, p3]
-          [bpA, bpB, bpC] <- mapM insert'
+              [bpA, bpB, bpC] <- mapM insert'
-            [ BlogPost "A" p1k
+                [ BlogPost "A" p1k
-            , BlogPost "B" p1k
+                , BlogPost "B" p1k
-            , BlogPost "C" p2k ]
+                , BlogPost "C" p2k ]
-          ret <- select $
+              ret <- select $
-                 from $ \bp ->
+                     from $ \bp ->
-                 distinctOn [don (bp ^. BlogPostAuthorId)] $
+                     q bp $ return bp
-                 distinctOn [don (bp ^. BlogPostTitle)] $ do
+              let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal
-                 orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
+              liftIO $ ret `shouldBe` sortBy (comparing cmp) [bpA, bpB, bpC]
-                 return bp
+      it "works on a slightly less simple example (two distinctOn calls, orderBy)" $
-          let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal
+        slightlyLessSimpleTest $ \bp act ->
-          liftIO $ ret `shouldBe` sortBy (comparing cmp) [bpA, bpB, bpC]
+          distinctOn [don (bp ^. BlogPostAuthorId)] $
+          distinctOn [don (bp ^. BlogPostTitle)] $ do
+            orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
+            act
+      it "works on a slightly less simple example (one distinctOn call, orderBy)" $ do
+        slightlyLessSimpleTest $ \bp act ->
+          distinctOn [don (bp ^. BlogPostAuthorId), don (bp ^. BlogPostTitle)] $ do
+            orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
+            act
+      it "works on a slightly less simple example (distinctOnOrderBy)" $ do
+        slightlyLessSimpleTest $ \bp ->
+          distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
 #endif
 
     describe "coalesce/coalesceDefault" $ do