diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 3055c5c..89f8995 100644 --- a/src/Database/Esqueleto.hs +++ b/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_ , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 311b771..ca461ef 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/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/ diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 5e8353e..2a82e2c 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/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 diff --git a/test/Test.hs b/test/Test.hs index 943f32a..a6184b7 100644 --- a/test/Test.hs +++ b/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 - run $ do - [p1k, p2k, _] <- mapM insert [p1, p2, p3] - [bpA, bpB, bpC] <- mapM insert' - [ BlogPost "A" p1k - , BlogPost "B" p1k - , BlogPost "C" p2k ] - ret <- select $ - from $ \bp -> - distinctOn [don (bp ^. BlogPostAuthorId)] $ - distinctOn [don (bp ^. BlogPostTitle)] $ do - orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)] - return bp - let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal - liftIO $ ret `shouldBe` sortBy (comparing cmp) [bpA, bpB, bpC] + let slightlyLessSimpleTest q = + run $ do + [p1k, p2k, _] <- mapM insert [p1, p2, p3] + [bpA, bpB, bpC] <- mapM insert' + [ BlogPost "A" p1k + , BlogPost "B" p1k + , BlogPost "C" p2k ] + ret <- select $ + from $ \bp -> + q bp $ return bp + let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal + liftIO $ ret `shouldBe` sortBy (comparing cmp) [bpA, bpB, bpC] + it "works on a slightly less simple example (two distinctOn calls, orderBy)" $ + slightlyLessSimpleTest $ \bp act -> + 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