Incorrect queries generated when using `nub_` or `pgNubBy_` as source for window function

[emilaxelsson]

The code at the bottom queries the persons table to find each unique valid_from day paired with the next unique valid_from day. However, the generated queries use DISTINCT incorrectly.

This could be related to #531.

Expected result

The unique days are 2025-01-01, 2025-01-02 and 2025-01-03. Pairing each day with the next should give:

(2025-01-01,Just 2025-02-02)
(2025-01-02,Just 2025-03-03)
(2025-01-03,Nothing)

This is equivalent to what the following query produces:

WITH commits AS (
  SELECT DISTINCT valid_from FROM persons
)
SELECT valid_from, LEAD(valid_from)
OVER (ORDER BY valid_from ASC) FROM commits

Actual result with pgNubBy_ id

(2025-01-01,Just 2025-01-01)
(2025-01-02,Just 2025-01-02)
(2025-01-03,Just 2025-01-03)

Actual result with nub_

(2025-01-03,Nothing)
(2025-01-02,Just 2025-01-03)
(2025-01-01,Just 2025-01-01)
(2025-01-01,Just 2025-01-02)
(2025-01-03,Just 2025-01-03)
(2025-01-02,Just 2025-01-02)

Code

#!/usr/bin/env stack
{- stack script
    --snapshot lts-23.0
    --system-ghc
    --package beam-core
    --package beam-postgres
    --package postgresql-simple
    --package text
    --package time
-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

import Data.Coerce (coerce)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Database.Beam
import Database.Beam.Postgres
import Database.PostgreSQL.Simple (Query, execute_)

data PersonT f = Person
    { name :: C f Text
    , title :: C f Text
    , valid_from :: C f Day
    }
    deriving (Generic)

type Person = PersonT Identity

type PersonExpr s = PersonT (QExpr Postgres s)

deriving instance Show Person
deriving instance Eq Person

instance Beamable PersonT

instance Table PersonT where
    data PrimaryKey PersonT f = PersonKey (C f Text)
        deriving stock (Generic)
        deriving anyclass (Beamable)

    primaryKey Person{name} = PersonKey name

data Db f = Db
    { persons :: f (TableEntity PersonT)
    }
    deriving (Generic)

instance Database Postgres Db

db :: DatabaseSettings Postgres Db
db = defaultDbSettings

-- | All unique days from @persons@
commits :: Q Postgres Db s (QGenExpr QValueContext Postgres s Day)
-- commits = nub_ $ fmap valid_from $ all_ $ persons db
commits = pgNubBy_ id $ fmap valid_from $ all_ $ persons db

-- For fixing the type of `lead1_`; see <https://github.com/haskell-beam/beam/issues/745>
fixType :: QExpr Postgres s a -> QExpr Postgres s (Maybe a)
fixType = coerce

-- | The result of 'commits' each paired with the day of the next commit
commitsWithValidTo ::
    Q Postgres Db s
        ( QGenExpr QValueContext Postgres s Day
        , QGenExpr QValueContext Postgres s (Maybe Day)
        )
commitsWithValidTo =
    fmap fixType <$>
        withWindow_
            ( \valid_from ->
                frame_
                    noPartition_
                    (orderPartitionBy_ (asc_ valid_from))
                    noBounds_
            )
            ( \valid_from w ->
                (valid_from, lead1_ valid_from `over_` w)
            )
            commits

main = do
    conn <- connect defaultConnectInfo {connectDatabase = "test"}

    execute_ conn
        $ "create table if not exists persons"
        <> "(name varchar, title varchar, valid_from date)"
    execute_ conn
        $ "delete from persons"
    execute_ conn
        $ "insert into persons (name, title, valid_from) values"

        -- Commit 1
        <> "('Janne', 'Mechanic', '2025-01-01'),"
        <> "('Jenny', 'Consultant', '2025-01-01'),"

        -- Commit 2
        <> "('Janne', 'Cleaner', '2025-01-02'),"
        <> "('Jenny', 'Assistant', '2025-01-02'),"

        -- Commit 3
        <> "('Janne', 'CEO', '2025-01-03'),"
        <> "('Jenny', 'CFO', '2025-01-03')"

    allCommits <- runBeamPostgresDebug putStrLn conn $
        runSelectReturningList $ select commits

    allCommitsWithValidTo <- runBeamPostgresDebug putStrLn conn $
        runSelectReturningList $ select commitsWithValidTo


    putStrLn "----"
    mapM_ print allCommits
    putStrLn "----"
    mapM_ print allCommitsWithValidTo

[LaurentRDC]

Thank you for your report, and especially the reproducible example. I should have time to look at this over the weekend

[LaurentRDC]

The commitsWithValidTo query results in the following SQL:

SELECT 
  DISTINCT ON (valid_from) 
  valid_from AS res0, 
  LEAD(valid_from) OVER (
    ORDER BY 
      valid_from ASC
  ) AS res1 
FROM 
  persons

I believe that the results you are getting are expected. With the data in the table, removing the use of pgNubBy_, the query becomes:

SELECT 
  valid_from AS res0, 
  LEAD(valid_from) OVER (
    ORDER BY 
      valid_from ASC
  ) AS res1 
FROM 
  persons

and should (and does!) give the results:

[(2025-01-01, 2025-01-01),
(2025-01-01, 2025-01-02),
(2025-01-02, 2025-01-02),
(2025-01-02, 2025-01-03),
(2025-01-03, 2025-01-03),
(2025-01-03, NULL)]

When adding pgNubBy_ (and thus, DISTINCT ON valid_from, rows 0, 2, and 4 will be selected, leading to

[(2025-01-01, 2025-01-01),
(2025-01-02, 2025-01-02),
(2025-01-03, 2025-01-03),

[LaurentRDC]

When it comes to using nub_, the SQL produced is:

SELECT DISTINCT 
  valid_from AS res, 
  LEAD(t0.valid_from) OVER (
    ORDER BY 
      t0.valid_from ASC
  ) AS res1 
FROM 
  persons AS t0

In principle, the DISTINCT applies to every whole row from the result set, so we expect result like above, when we removed pgNubBy_:

[(2025-01-01, 2025-01-01),
(2025-01-01, 2025-01-02),
(2025-01-02, 2025-01-02),
(2025-01-02, 2025-01-03),
(2025-01-03, 2025-01-03),
(2025-01-03, NULL)]

which is what you're getting, albeit in a strange order. In any case, the appropriate SQL is generated and sent to the database

[emilaxelsson]

Am I not correct to think that nub_ and pgNubBy_ should behave like the corresponding functions for lists?

Here is a (presumably) equivalent test case for lists:

import Data.List

type Day = Int

data Person = Person
  { name :: String
  , title :: String
  , validFrom :: Day
  }

persons :: [Person]
persons =
    -- Commit 1
  [ Person "Janne" "Mechanic" 1
  , Person "Jenny" "Consultant" 1

    -- Commit 2
  , Person "Janne" "Cleaner" 2
  , Person "Jenny" "Assistant" 2

    -- Commit 3
  , Person "Janne" "CEO" 3
  , Person "Jenny" "CFO" 3
  ]

commits :: [Day]
commits = nub $ map validFrom persons

commitsWithValidTo :: [(Day, Maybe Day)]
commitsWithValidTo = commits `zip` tail (map Just commits ++ repeat Nothing)

main = mapM_ print commitsWithValidTo

It prints the equivalent of "Expectated result" above:

(1,Just 2)
(2,Just 3)
(3,Nothing)

OTOH, if I move nub $ from commits to commitsWithValidTo, then I get the same as "Actual result with nub_" above:

(1,Just 1)
(1,Just 2)
(2,Just 2)
(2,Just 3)
(3,Just 3)
(3,Nothing)

To reproduce "Actual result with pgNubBy_ id", we need the following function from Data.List.Extra:

nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn f = map snd . nubBy ((==) `on` fst) . map (\x -> let y = f x in y `seq` (y, x))

Now, remove nub $ from commits and change commitsWithValidTo to the following:

commitsWithValidTo :: [(Day, Maybe Day)]
commitsWithValidTo = nubOn fst $ commits `zip` tail (map Just commits ++ repeat Nothing)

The result is the same as "Actual result with pgNubBy_ id":

(1,Just 1)
(2,Just 2)
(3,Just 3)

To summarize:

• nubOn_ id behaves differently than nub_
• Neither behaves like nub for lists

[LaurentRDC]

Ahh I see what you mean; your initial commitsWithValidTo should result in the following SQL:

SELECT 
  valid_from AS res0, 
  LEAD(valid_from) OVER (
    ORDER BY 
      valid_from ASC
  ) AS res1 
FROM 
 -- DISTINCT is applied in the inner query
  (SELECT 
    DISTINCT valid_from 
  FROM persons
)

thank you for explaining.

[emilaxelsson]

should result in the following SQL

Yes, exactly!

[LaurentRDC]

My guess is that something is going wrong when building the query, since the definitions of pgNubBy_ and nub_ don't do much.

I haven't had time to look into it yet though