Left join in Opaleye

I have been trying to run a left join using Opaleye in a project but I'm not being able to make the code compile. I start with two "models" which represent tables that are associated:

First:

data ModelA' a b = Model { primA :: a, foreignA :: b }
type ModelA = ModelA' UUID UUID
type ModelAColumn = ModelA' (Column PGUuid) (Column (Nullable PGUuid))

$(makeAdaptorAndInstance "pModelA" ''ModelA')

table :: Table ModelAColumn ModelAColumn
table = Opaleye.table "model_a" $ pModelA (ModelA (tableColumn "uuid") (tableColumn "foreign"))

And also:

data ModelB' a b = Model { primB :: a, valB :: b }
type ModelB = ModelB' UUID String
type ModelBColumn = ModelB' (Column PGUuid) (Column PGText)

$(makeAdaptorAndInstance "pModelB" ''ModelB')

table :: Table ModelBColumn ModelBColumn
table = Opaleye.table "model_b" $ pModelB (ModelB (tableColumn "uuid") (tableColumn "val"))

As the types reflect, ModelA can have no ModelB associated.

I need a query to obtain pairs of (ModelA, Maybe ModelB) given by the left join between the tables on foreignA == primB. I was expecting it to look like:

doJoin :: Connection -> IO [(ModelA, Maybe ModelB)]
doJoin conn = runQuery conn query
  where
    query :: Query (ModelAColumn, Maybe ModelBColumn)
    query = leftJoin (queryTable ModelA.table) (queryTable ModelB.table) (\(ma, mb) -> foreignA ma .== primB mb)

But this does not work. I've also tried multiple variants, in particular I replaced the type signature in query to explicitly state the nullability of the columns at the right:

query :: Query (ModelAColumn, (Column (Nullable PGUuid), Column (Nullable PGText))

But this fails with:

No instance for Data.Profunctor.Product.Default.Class.Default Opaleye.Internal.Join.NullMaker ModelBColumn (Column (Nullable PGUuid), Column (Nullable PGText).

How can I make this query in Opaleye?

Solution

There are a couple of misunderstandings here. I produced a full working version below.

Firstly, the return type of the leftJoin is not

Query (ModelAColumn, Maybe ModelBColumn)

You have to do

type ModelBNullableColumn = ModelB' (Column (Nullable PGUuid))
                                    (Column (Nullable PGText))

and then use

Query (ModelAColumn, ModelBNullableColumn)

Secondly, the return type of the runQuery is not

IO [(ModelA, Maybe ModelB)]

You have to do

type ModelBMaybe = ModelB' (Maybe UUID) (Maybe String)

and use

IO [(ModelA, ModelBMaybe)]

The reason for these differences is that Nullable and Maybe must be applied directly to every column and value in the ModelBColumn and ModelB not to the values as a whole.

(There are also some weird syntax errors like

ModelA { tableColumn "uuid", tableColumn "foreign" }

which means your code has no hope of compiling. I fixed those, too.)

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Opaleye hiding (table)
import qualified Opaleye
import Data.Profunctor.Product.TH
import Database.PostgreSQL.Simple hiding (Query)
import Data.UUID

data ModelA' a b = ModelA { primA :: a, foreignA :: b }
type ModelA = ModelA' UUID (Maybe UUID)
type ModelAColumn = ModelA' (Column PGUuid) (Column (Nullable PGUuid))

$(makeAdaptorAndInstance "pModelA" ''ModelA')

modelAtable :: Table ModelAColumn ModelAColumn
modelAtable = Opaleye.table "model_a" $ pModelA ModelA { primA = tableColumn "uuid", foreignA = tableColumn "foreign" }

data ModelB' a b = ModelB { primB :: a, valB :: b }
type ModelB = ModelB' UUID String
type ModelBMaybe = ModelB' (Maybe UUID) (Maybe String)
type ModelBColumn = ModelB' (Column PGUuid) (Column PGText)
type ModelBNullableColumn = ModelB' (Column (Nullable PGUuid)) (Column (Nullable PGText))

$(makeAdaptorAndInstance "pModelB" ''ModelB')

modelBtable :: Table ModelBColumn ModelBColumn
modelBtable = Opaleye.table "model_b" $ pModelB ModelB { primB = tableColumn "uuid", valB = tableColumn "val" }

doJoin :: Connection -> IO [(ModelA, ModelBMaybe)]
doJoin conn = runQuery conn query
  where
    query :: Query (ModelAColumn, ModelBNullableColumn)
    query = leftJoin (queryTable modelAtable) (queryTable modelBtable) (\(ma, mb) -> matchNullable (pgBool False) (.== primB mb) (foreignA ma))

main :: IO ()
main = return ()