Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

runSelect type error when nullable fkey column is wrapped in newtype #539

Open
derrickbeining opened this issue Jan 13, 2022 · 11 comments
Open

Comments

@derrickbeining
Copy link

I'm having trouble figuring out how to resolve a compiler error I'm getting at the call site of runSelect after I attempted to wrap a nullable foreign key column in a newtype. I can get it to compile fine if I remove the newtype in the Read- and WriteField. Here's a link to a repo and specific line of code where the error is, if anyone cares to run it locally to inspect closer.

This is the table definition:

type TaskRow =
  DB.LocalTimestampedRow
    ( TaskRow'
        (Maybe User.PKey) -- ownerId
        PKey -- pkey
        Uuid -- uuid
    )

type WriteField =
  DB.LocalTimestampedWriteField
    ( TaskRow'
        (User.PKey' (Maybe (DB.FieldNullable DB.PGInt4))) -- added newtype here
        PKeyWriteField
        UuidWriteField
    )

type ReadField =
  DB.LocalTimestampedReadField
    ( TaskRow'
        (User.PKey' (DB.FieldNullable DB.PGInt4)) -- added newtype here
        PKeyReadField
        UuidReadField
    )

table :: DB.Table WriteField ReadField
table =
  DB.table "gigs" . DB.pTimestampedRow . DB.withLocalTimestampFields $
    pTaskRow rowDef
  where
    rowDef =
      TaskRow
        { ownerId' = User.pPKeyTableField $ DB.tableField "owner_id" 
        , pkey' = pPKey . PKey $ DB.readOnlyTableField "id"
        , uuid' = pUuid . Uuid $ DB.tableField "uuid"
        }

The query I'm trying to run looks like this (ignore the graphql stuff; I just wrapped runSelect to lift the resulting IO into a custom monad for morpheus-graphql):

getRows :: GQL.Composed o m [] (TaskRow, Maybe User.UserRow)
getRows = GQL.runSelect query -- <------------------------------------------ type error here

query :: DB.Select (ReadField, DB.MaybeFields User.ReadField)
query = do
  task <- select
  mOwner <-
    DB.optionalRestrict User.select
      `DB.viaLateral` userIsOwner (ownerId' (DB.record task))
  pure (task, mOwner)

userIsOwner :: User.PKey' (DB.Column (DB.Nullable DB.SqlInt4)) -> User.ReadField -> DB.Field DB.SqlBool
userIsOwner ownerIdField u =
  ownerIdField .=== (DB.toNullable <$> User.pkey' (DB.record u))

The type error I'm getting is this:

• Couldn't match type ‘Maybe User.PKey’ with ‘User.PKey' a1_3’
    arising from a use of ‘GQL.runSelect’
• In the expression: GQL.runSelect query
  In an equation for ‘getRows’: getRows = GQL.runSelect query
  In an equation for ‘resolveAll’:
      resolveAll
        = do rows <- getRows
             pure $ flip fmap rows $ \ (task, mUser) -> ...
        where
            getRows :: GQL.Composed o m [] (TaskRow, Maybe User.UserRow)
            getRows = GQL.runSelect query
            query :: DB.Select (ReadField, DB.MaybeFields User.ReadField)
            query
              = do task <- select
                   ....
            ....

Would love to understand what I'm doing wrong and how to fix it, and what I should perhaps learn from this type error so that I can better interpret future errors like this that I run into.

@tomjaguarpaw
Copy link
Owner

Will have a look in more detail at this later, but just a quick comment to check: perhaps it should be a User.PKey (Maybe a) rather than a Maybe (User.PKey a)?

@derrickbeining
Copy link
Author

hmm, I'd really like not to have to nest a maybe inside of User.PKey. Do you think that because the WriteField definition has the Maybe inside of PKey' ? I only did that because that's how I've seen all examples of optional newtyped columns done.

@derrickbeining
Copy link
Author

Okay, I tried User.PKey (Maybe Int) and I can get it to compile with that... but why??? And is there someway I can make Maybe User.PKey work?

@tomjaguarpaw
Copy link
Owner

User.PKey (Maybe Int) is the natural consequence of treating User.PKey as a collection of fields, which is what the product-profunctors machinery does. Suppose that instead of a single field your primary key was a composite key of a pair of nullable fields. Then you absolutely wouldn't be able to map it to Maybe (User.PKey Int Int) without losing information. It would have to be User.PKey (Maybe Int) (Maybe Int). Having Maybe on the inside of single-field PKey is consistent with that idea.

There is an alternative, which is to define your own SQL type and its mapping to a Haskell type (see below).

So I guess there are three options

  1. Stick with Maybe inside User.PKey
  2. Get Maybe outside User.PKey by defining your own SQL type
  3. Let me know a bit more about your needs and we can work out something more satisfactory.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}

module Main where

import Opaleye
import Opaleye.Internal.Inferrable (Inferrable(Inferrable))
import Data.Profunctor.Product.Default (Default, def)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance')
import Database.PostgreSQL.Simple (Connection)
import Database.PostgreSQL.Simple.FromField (fromField)

data SqlUserPKey

data UserPKey = UserPKey Int

data MyTableFields a b = MyTableFields a b

$(makeAdaptorAndInstance' ''MyTableFields)

myTable :: Table
           (MyTableFields (FieldNullable SqlUserPKey) (Field SqlInt4))
           (MyTableFields (FieldNullable SqlUserPKey) (Field SqlInt4))
myTable = table "myTable" (pMyTableFields $ MyTableFields
    (requiredTableField "myfield1")
    (requiredTableField "myfield2"))

instance DefaultFromField SqlUserPKey UserPKey where
  defaultFromField = fromPGSFieldParser ((fmap . fmap . fmap) UserPKey fromField)

instance Default (Inferrable FromField) SqlUserPKey UserPKey where
  def = Inferrable def

example :: Connection -> IO [MyTableFields (Maybe UserPKey) Int]
example conn = runSelectI conn (selectTable myTable)

@tomjaguarpaw
Copy link
Owner

Sorry, didn't mean to close this.

@tomjaguarpaw tomjaguarpaw reopened this Jan 16, 2022
@derrickbeining
Copy link
Author

I had attempted to go the route of defining my own custom sql type too, but struggled to figure out how to implement the classes needed to work with it.

Trying again with the example you provided above (thanks btw), I still need implement some other classes, probably even more after I resolve these errors:

    • No instance for (PP.Default
                         DB.ToFields Int (Col.Column SqlUserPKey))
        arising from a use of ‘DB.toFields’
    • In the second argument of ‘(.===)’, namely ‘DB.toFields pkey’
      In the second argument of ‘($)’, namely
        ‘pkey' (DB.record user) .=== DB.toFields pkey’
      In a stmt of a 'do' block:
        _ <- DB.where_ $ pkey' (DB.record user) .=== DB.toFields pkey
    |
237 |   DB.where_ $ pkey' (DB.record user) .=== DB.toFields pkey
    |                                           ^^^^^^^^^^^^^^^^

/Users/derrickbeining/dev/pinata-dev/Pinata/systems/Haskell/src/Pinata/Model/User.hs:270:9-46: error:
    • Could not deduce (DB.DefaultFromField SqlUserPKey Int)

Having to manually implement a bunch of classes every time I want a newtyped column feels undesirable.

After tinkering for a while, I discovered that I could get Maybe User.PKey to work by implementing

instance
  DB.DefaultFromField sqlType haskell =>
  PP.Default
    DB.FromFields
    (PKey' (DB.Column (DB.Nullable sqlType)))
    (Maybe (PKey' haskell))
  where
  def = PP.dimap unPKey (fmap PKey) PP.def

And then generalized it to

instance
  ( DB.DefaultFromField sql haskell
  , Coercible (wrapper (DB.Column (DB.Nullable sql))) (DB.Column (DB.Nullable sql))
  , Coercible (wrapper haskell) haskell
  ) =>
  PP.Default
    DB.FromFields
    (wrapper (DB.Column (DB.Nullable sql)))
    (Maybe (wrapper haskell))
  where
  def =
    PP.dimap
      coerce
      (fmap coerce)
      ( PP.def
          @DB.FromFields
          @(DB.Column (DB.Nullable sql))
          @(Maybe haskell)
      )

so it could work with any newtype wrapper around FieldNullable sqlType.

Does this seem sensible or am I just wandering too far from the happy path?

@tomjaguarpaw
Copy link
Owner

after I resolve these errors:

Did you define your type data UserPKey = UserPKey Int? You should be converting that to and from Field SqlUserPKey but it looks like you are trying to convert naked Int instead.

If you still can't get it to work then please your latest version to your GitHub repo and I'll take a look.

I still need implement some other classes

Yes, you most likely will.

Having to manually implement a bunch of classes every time I want a newtyped column feels undesirable.

Yeah it is. That's why the Default machinery exists: it basically implements all those classes for you, almost for free.

Does this seem sensible or am I just wandering too far from the happy path?

Hmm, well it might work but it's also likely to be very fragile and break in hard to diagnose ways. I wouldn't recommend it, but you can try if you like!

@derrickbeining
Copy link
Author

Did you define your type data UserPKey = UserPKey Int?

Yeah, I thought so. I think I just hadn't finished propogating the change to SqlUserKey through the rest of the code.

So I think I've got it working now with your suggestion, but I used a newtype around PGInt4 instead of an empty data declaration.

With the user pkey designed like this

newtype PKey' a = PKey
  { unPKey :: a
  }

$(PPTH.makeAdaptorAndInstance "pPKey" ''PKey')

newtype SqlPKey = SqlPKey {unSqlPKey :: DB.PGInt4}

instance PP.Default DB.ToFields PKey (Col.Column SqlPKey) where
  def = PP.dimap coerce coerce (PP.def @DB.ToFields @Int @(DB.Column DB.PGInt4))

instance DB.DefaultFromField SqlPKey PKey where
  defaultFromField = DB.fromPGSFieldParser ((fmap . fmap . fmap) PKey PGS.fromField)

instance PP.Default (Inferrable DB.FromField) SqlPKey PKey where
  def = Inferrable PP.def

type PKey = PKey' Int

type PKeyReadField =
  (DB.Field SqlPKey)

type PKeyWriteField =
  ()

And using it as a nullable foreign key on another table like this

type TaskRow =
  DB.LocalTimestampedRow
    ( TaskRow'
        (Maybe User.PKey) -- ownerId
        PKey -- pkey
        Uuid -- uuid
    )

type WriteField =
  DB.LocalTimestampedWriteField
    ( TaskRow'
        (Maybe (DB.FieldNullable User.SqlPKey))
        PKeyWriteField
        UuidWriteField
    )

type ReadField =
  DB.LocalTimestampedReadField
    ( TaskRow'
        (DB.FieldNullable User.SqlPKey)
        PKeyReadField
        UuidReadField
    )

allows me to retain User.PKey as User.PKey' Int instead of having to make it User.PKey' (Maybe Int).

Designing the data this way, newtyping the sql type instead of the whole field/column type, feels the most intuitive to read to me. It would be nice if we could make it so that newtyping an existing sql/pg type would just work and reuse all the classes implemented for the underlying type.

@derrickbeining
Copy link
Author

derrickbeining commented Jan 17, 2022

@tomjaguarpaw do you think that would be a good idea? Having instances defined that would allow folks to newtype any sqlType like SqlInt4 etc and everything still just work as before? I think all that's need is these two instances:

instance
  ( PP.Default DB.ToFields haskellType (DB.Column sqlType)
  , Coercible (wrapper haskellType) haskellType
  , Coercible (wrapper sqlType) sqlType
  ) =>
  PP.Default DB.ToFields (wrapper haskellType) (DB.Column (wrapper sqlType))
  where
  def = PP.dimap coerce coerce (PP.def @DB.ToFields @haskellType @(DB.Column sqlType))


instance
  ( Coercible (wrapper sqlType) sqlType
  , Coercible (wrapper haskellType) haskellType
  , PGS.FromField haskellType
  ) =>
  DB.DefaultFromField (wrapper sqlType) (wrapper haskellType)
  where
  defaultFromField =
    DB.fromPGSFieldParser $
      (fmap . fmap . fmap) (coerce @haskellType @(wrapper haskellType)) PGS.fromField

With these orphan instances implemented in my project, I can simply define my primary key type like so

-- User.hs

newtype PKey' a = PKey
  { unPKey :: a
  }

$(PPTH.makeAdaptorAndInstance "pPKey" ''PKey')

-- | Haskell PKey
type PKey = PKey' Int

-- | Opaleye Sql PKey
type SqlPKey = PKey' DB.PGInt4

type PKeyReadField =
  (DB.Field SqlPKey)

type PKeyWriteField =
  () -- Disallow writing to the pkey column

And with things defined this way, I can define the nullable fkey on my other model the way I wanted, where the Maybe can remain on the outside of the newtype like this:

-- Task.hs

type TaskRow =
  DB.LocalTimestampedRow
    ( TaskRow'
        (Maybe User.PKey) -- ownerId
        PKey -- pkey
        Uuid -- uuid
    )

type WriteField =
  DB.LocalTimestampedWriteField
    ( TaskRow'
        (Maybe (DB.FieldNullable User.SqlPKey))
        PKeyWriteField
        UuidWriteField
    )

type ReadField =
  DB.LocalTimestampedReadField
    ( TaskRow'
        (DB.FieldNullable User.SqlPKey)
        PKeyReadField
        UuidReadField
    )

@derrickbeining
Copy link
Author

I've since been advised against using Coercible for this, as others have experienced significant deterioration of type inference in past attempts to implement classes in terms of Coercible. So, I guess I retract my question.

@tomjaguarpaw
Copy link
Owner

FYI type PKeyWriteField = () suggests you are using readOnly. readOnly seems to be problematic (see #535) and so I am anticipating deprecating it.

It would be nice if we could make it so that newtyping an existing sql/pg type would just work and reuse all the classes implemented for the underlying type.

I've since been advised against using Coercible for this, as others have experienced significant deterioration of type inference in past attempts to implement classes in terms of Coercible. So, I guess I retract my question.

Maybe there's a DerivingVia approach that would work well here. I agree with the advice you received that trying to do it with this super-powerful instance is likely to lead to a lot of breakage and frustration.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants