3

I'm trying to do a leftJoin using the following query:

      select $ do
        (event :& _ :& tags) <- from
            $ table @EventRow `leftJoin` table @EventTagRow
            `on` ( \(event :& links) ->
                     event ^. EventRowId ==. links ?. EventTagRowEventId
                 )
              `leftJoin` table @TagRow
            `on` ( \(_ :& link :& tag) ->
                     tag ?. TagRowId ==. link ?. EventTagRowTagId
                 )
        where_ (event ^. EventRowTitle ==. val "one")
        pure tags

The problem I have is that the line event ^. EventRowId ==. links ?. EventTagRowEventId complains that EventRowId gives an ID type, but ==. wants Maybe <id type>. This makes sense, when I look at the definitions of ?. and ==. they are:

(?.) :: (PersistEntity val, PersistField typ) => SqlExpr (Maybe (Entity val)) -> EntityField val typ -> SqlExpr (Value (Maybe typ)) 
(==.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)

Which would imply that the LHS and RHS both have to be maybe. Yet the docs for Database.Esqueleto.Experimental give the following example (see "Example 2: Select with join" in the section "A New Syntax"):

select $ do
(people :& blogPosts) <-
    from $ table @Person
    `leftJoin` table @BlogPost
    `on` (\(people :& blogPosts) ->
            people ^. PersonId ==. blogPosts ?. BlogPostAuthorId)
where_ (people ^. PersonAge >. val 18)
pure (people, blogPosts)

Which implies that ==. can take a SqlExpr (Value typ) -> SqlExpr (Maybe (Value typ)). Is the documentation wrong or am I doing something wrong?

duplode
  • 33,731
  • 7
  • 79
  • 150
GTF
  • 8,031
  • 5
  • 36
  • 59
  • I haven't tried to reproduce the problem, and it's been a long time sice I last used Esqueleto, but anyway, a guess: does it work if you change `tag ?. TagRowId` to `tag ^. TagRowId` in your second left join? As far as that join is concerned, the tag is supposed to exist. – duplode May 12 '23 at 21:29
  • @duplode no it doesn't because `leftJoin` produces `Maybe (Entity val)`s rather than `Entity val`s. The thing I'm most concerned by is that the Esqueleto documentation just seems inconsistent... – GTF May 13 '23 at 15:38
  • The documentation bug has now been fixed in Esqueleto 3.5.9.1. Thanks for bringing it into light! – duplode Jun 08 '23 at 18:31

1 Answers1

2

Wrapping the left hand side of the first on clause in just, which lifts values into Maybe, fixes the type error:

        `on` ( \(event :& links) ->
                 just (event ^. EventRowId) ==. links ?. EventTagRowEventId
             )

There was indeed a documentation bug (see Esqueleto issue #307) which has since been fixed in Esqueleto 3.5.9.1.

Below is a runnable demo of the fixed code:

{- cabal:
build-depends: base >= 4.16
            , persistent
            , persistent-sqlite
            , esqueleto >= 3.5.8
            , text
-}
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}

module Main where

import Control.Monad.IO.Class (liftIO)
import Database.Persist.Sqlite (runSqlite)
import Database.Persist.TH
import Database.Esqueleto.Experimental
import Data.Text (Text)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
EventRow
  title Text
  deriving Show
EventTagRow
  eventId EventRowId
  tagId TagRowId
  deriving Show
TagRow
  deriving Show
|]

main :: IO ()
main = runSqlite ":memory:" $ do
  runMigration migrateAll

  event1 <- insert $ EventRow "one"
  event2 <- insert $ EventRow "two"
  event3 <- insert $ EventRow "three"

  tag1 <- insert $ TagRow
  tag2 <- insert $ TagRow

  insert $ EventTagRow event1 tag1
  insert $ EventTagRow event3 tag2

  tags <- select $ do
    (event :& _ :& tags) <- from
        $ table @EventRow `leftJoin` table @EventTagRow
        `on` ( \(event :& links) ->
                 just (event ^. EventRowId) ==. links ?. EventTagRowEventId
             )
          `leftJoin` table @TagRow
        `on` ( \(_ :& link :& tag) ->
                 tag ?. TagRowId ==. link ?. EventTagRowTagId
             )
    where_ (event ^. EventRowTitle ==. val "one")
    pure tags
  liftIO $ do
    putStrLn "\nTesting...\n"
    print tags
duplode
  • 33,731
  • 7
  • 79
  • 150