Make distinctOn work like orderBy via 'don'.

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, having
+             , distinct, distinctOn, don, having
              , sub_select, sub_selectDistinct, (^.), (?.)
              , val, isNothing, just, nothing, joinV, countRows, count, not_
              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
@@ -60,6 +60,7 @@ module Database.Esqueleto
   , unValue
   , ValueList(..)
   , OrderBy
+  , DistinctOn
     -- ** Joins
   , InnerJoin(..)
   , CrossJoin(..)

src/Database/Esqueleto/Internal/Language.hs

@@ -27,6 +27,7 @@ module Database.Esqueleto.Internal.Language
   , FullOuterJoin(..)
   , OnClauseWithoutMatchingJoinException(..)
   , OrderBy
+  , DistinctOn
   , Update
   , Insertion
     -- * The guts
@@ -206,18 +207,18 @@ class (Functor query, Applicative query, Monad query) =>
   -- @
   -- select $
   --   'from' \\foo ->
-  --   distinctOn [foo ^. FooName, foo ^. FooState] $ do
+  --   'distinctOn' ['don' (foo ^. FooName), 'don' (foo ^. FooState)] $ do
   --   ...
   -- @
   --
-  -- You can also chain different calls to 'distinctOn' whenever
-  -- your fields have different types:
+  -- You can also chain different calls to 'distinctOn'.  The
+  -- above is equivalent to:
   --
   -- @
   -- select $
   --   'from' \\foo ->
-  --   distinctOn [foo ^. FooName] $
-  --   distinctOn [foo ^. FooState] $ do
+  --   'distinctOn' ['don' (foo ^. FooName)] $
+  --   'distinctOn' ['don' (foo ^. FooState)] $ do
   --   ...
   -- @
   --
@@ -232,7 +233,13 @@ class (Functor query, Applicative query, Monad query) =>
   -- Supported by PostgreSQL only.
   --
   -- /Since: 2.2.4/
-  distinctOn :: [expr (Value b)] -> query a -> query a
+  distinctOn :: [expr DistinctOn] -> query a -> query a
+
+  -- | Erase an expression's type so that it's suitable to
+  -- be used by 'distinctOn'.
+  --
+  -- /Since: 2.2.4/
+  don :: expr (Value a) -> expr DistinctOn
 
   -- | @ORDER BY random()@ clause.
   --
@@ -661,6 +668,10 @@ data PreprocessedFrom a
 data OrderBy
 
 
+-- | Phantom type used by 'distinctOn' and 'don'.
+data DistinctOn
+
+
 -- | Phantom type for a @SET@ operation on an entity of the given
 -- type (see 'set' and '(=.)').
 data Update typ

src/Database/Esqueleto/Internal/Sql.hs

@@ -123,7 +123,7 @@ instance Monoid SideData where
 data DistinctClause =
     DistinctAll                     -- ^ The default, everything.
   | DistinctStandard                -- ^ Only @DISTINCT@, SQL standard.
-  | DistinctOn [SqlExpr (Value ())] -- ^ @DISTINCT ON@, PostgreSQL extension.
+  | DistinctOn [SqlExpr DistinctOn] -- ^ @DISTINCT ON@, PostgreSQL extension.
 
 instance Monoid DistinctClause where
   mempty = DistinctAll
@@ -328,6 +328,9 @@ data SqlExpr a where
   EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
   EOrderRandom :: SqlExpr OrderBy
 
+  -- A 'SqlExpr' accepted only by 'distinctOn'.
+  EDistinctOn :: SqlExpr (Value a) -> SqlExpr DistinctOn
+
   -- A 'SqlExpr' accepted only by 'set'.
   ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)
 
@@ -398,9 +401,9 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
   limit  n = Q $ W.tell mempty { sdLimitClause = Limit (Just n) Nothing  }
   offset n = Q $ W.tell mempty { sdLimitClause = Limit Nothing  (Just n) }
 
-  distinct         act = Q (W.tell mempty { sdDistinctClause = DistinctStandard  }) >> act
-  distinctOn exprs act = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs' }) >> act
-    where exprs' = map veryUnsafeCoerceSqlExprValue exprs
+  distinct         act = Q (W.tell mempty { sdDistinctClause = DistinctStandard }) >> act
+  distinctOn exprs act = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs }) >> act
+  don = EDistinctOn
 
   sub_select         = sub SELECT
   sub_selectDistinct = sub_select . distinct
@@ -1002,7 +1005,8 @@ makeSelect info mode_ distinctClause ret = process mode_
         DistinctAll      -> ("SELECT ", [])
         DistinctStandard -> ("SELECT DISTINCT ", [])
         DistinctOn exprs -> first (("SELECT DISTINCT ON (" <>) . (<> ") ")) $
-                            uncommas' (materializeExpr info <$> exprs)
+                            uncommas' (processExpr <$> exprs)
+      where processExpr (EDistinctOn f) = materializeExpr info f
     withCols v = v <> (sqlSelectCols info ret)
     plain    v = (v, [])
 

test/Test.hs

@@ -820,7 +820,7 @@ main = do
             , BlogPost "C" p2k ]
           ret <- select $
                  from $ \bp ->
-                 distinctOn [bp ^. BlogPostAuthorId] $ do
+                 distinctOn [don (bp ^. BlogPostAuthorId)] $ do
                  orderBy [asc (bp ^. BlogPostAuthorId), desc (bp ^. BlogPostTitle)]
                  return bp
           liftIO $ ret `shouldBe` sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC]
@@ -834,8 +834,8 @@ main = do
             , BlogPost "C" p2k ]
           ret <- select $
                  from $ \bp ->
-                 distinctOn [bp ^. BlogPostAuthorId] $
-                 distinctOn [bp ^. BlogPostTitle] $ do
+                 distinctOn [don (bp ^. BlogPostAuthorId)] $
+                 distinctOn [don (bp ^. BlogPostTitle)] $ do
                  orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
                  return bp
           let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal