Support promoted types in Quasi Quoter #1258

danbroooks · 2021-04-28T21:04:05Z

Before submitting your PR, check that you've:

Documented new APIs with Haddock markup
Added @since declarations to the Haddock
Ran stylish-haskell on any changed files.
Adhered to the code style (see the .editorconfig file for details)

After submitting your PR:

Update the Changelog.md file with a link to your PR
Bumped the version number if there isn't an (unreleased) on the Changelog
Check that CI passes (or if it fails, for reasons unrelated to your change, like CI timeouts)

I've opened this as a draft PR with a view towards getting some feedback on it still. I think everything here should be fine for addressing that ticket, but there might be something I have overlooked here. I will annotate what I've got so far.

I have also opened this PR against master as it is not a super invasive change, and I would be happy to deal with porting it forward into the persistent-2.13 branch after it is merged in. Alternatively if it is preferred that this PR goes against that branch, and is backported to master, I'd be happy to do that as well.

It may also make sense for this to just go into 2.13 like my other recent change 👍

danbroooks · 2021-04-28T21:10:23Z

persistent/test/Database/Persist/TH/KindEntitiesSpec.hs

+        let UserName = #name
+            OrganizationName = #name
+            DogName = #name
+-}


There might be some more stuff to do here for this test maybe ... for now I have something that just asserts that it typechecks 👍

Yeah - let's check the type of the field accessors and the EntityFields.

Still should jsut be a compilation check, but something like:

let mkTransfer :: CustomerId -> MoneyAmount 'CustomerOwned 'Debt -> CustomerTransfer mkTransfer = CustomerTransfer getAmount :: CustomerTransfer -> MoneyAmount 'CustomerOwned 'Debt getAmount = customerTransferMoneyAmount

danbroooks · 2021-04-28T21:13:53Z

persistent/Database/Persist/TH.hs

 mEmbedded ents (FTTypeCon Nothing (EntityNameHS -> name)) =
    maybe (Left Nothing) Right $ M.lookup name ents
+mEmbedded ents (FTTypePromoted (EntityNameHS -> name)) =
+    maybe (Left Nothing) Right $ M.lookup name ents


Not sure about this. I basically just mirrored what is done for FTTypeCon when there is no module (ie the case above).

Hmm - I'd say let's go with a Left Nothing on all cases here. If we hit this, it means we're trying to determine whether we need an embedded entity reference, which we shouldn't - the only place this could possibly be is if we've got an FTApp or similar, and we want the SQL type construction to proceed unchanged.

Suggested change

maybe (Left Nothing) Right $ M.lookup name ents

Left Nothing

Like, we'll have foo (Proxy 'User). That'll get turned into FTApp (FTypeCon Nothing "Proxy") (FTTypePromoted "User"). This code recurses and then finds that the corresponding EmbedEntityDef is for a User, even though that's totally wrong.

parsonsmatt

There are a few changes I'd like on this before accepting it, but it is fantastic work - thank you so much!

I'm afraid the changes I put into #1256 are going to be a massive conflict here. So let's get this merged in to master, we can release it as a patch bump since it's just a change to the QQ and purely additive. Then I'll work on getting it merged into persistent-2.13.

parsonsmatt · 2021-05-04T13:04:09Z

persistent/Database/Persist/Quasi.hs

+             in case T.breakOnEnd "." t of
+                (_, "") -> FTTypeCon Nothing t
+                ("", _) -> FTTypeCon Nothing t
+                (a, b) -> FTTypeCon (Just $ T.init a) b


Looks great 👍🏻

parsonsmatt · 2021-05-04T13:06:11Z

persistent/Database/Persist/TH.hs

 mEmbedded ents (FTTypeCon Nothing (EntityNameHS -> name)) =
    maybe (Left Nothing) Right $ M.lookup name ents
+mEmbedded ents (FTTypePromoted (EntityNameHS -> name)) =
+    maybe (Left Nothing) Right $ M.lookup name ents


Hmm - I'd say let's go with a Left Nothing on all cases here. If we hit this, it means we're trying to determine whether we need an embedded entity reference, which we shouldn't - the only place this could possibly be is if we've got an FTApp or similar, and we want the SQL type construction to proceed unchanged.

Suggested change

maybe (Left Nothing) Right $ M.lookup name ents

Left Nothing

Like, we'll have foo (Proxy 'User). That'll get turned into FTApp (FTypeCon Nothing "Proxy") (FTTypePromoted "User"). This code recurses and then finds that the corresponding EmbedEntityDef is for a User, even though that's totally wrong.

parsonsmatt · 2021-05-04T13:06:37Z

persistent/Database/Persist/TH.hs

+    FTApp x y ->
+        ftToType x `AppT` ftToType y
+    FTList x ->
+        ListT `AppT` ftToType x


👨🏻‍🍳

parsonsmatt · 2021-05-04T13:06:49Z

persistent/test/Database/Persist/TH/KindEntitiesSpec.hs

+-- {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Persist.TH.KindEntitiesSpec where


beautiful tests <3

parsonsmatt · 2021-05-04T13:09:24Z

persistent/test/Database/Persist/TH/KindEntitiesSpec.hs

+        let UserName = #name
+            OrganizationName = #name
+            DogName = #name
+-}


Yeah - let's check the type of the field accessors and the EntityFields.

Still should jsut be a compilation check, but something like:

let mkTransfer :: CustomerId -> MoneyAmount 'CustomerOwned 'Debt -> CustomerTransfer mkTransfer = CustomerTransfer getAmount :: CustomerTransfer -> MoneyAmount 'CustomerOwned 'Debt getAmount = customerTransferMoneyAmount

parsonsmatt · 2021-05-04T13:09:56Z

persistent/test/Database/Persist/TH/KindEntitiesSpecImports.hs

+    sqlType _ = SqlInt64
+
+instance PersistField (MoneyAmount a b) where
+    toPersistValue (MoneyAmount n) = PersistRational n


I don't think this PeristRational lines up with the SqlInt64 type you specified

- Correct instances for MoneyAmount - Add some additional compiler checks to spec - Removed commented out code - Remove redundant logic in mEmbedded

parsonsmatt

🎉

parsonsmatt · 2021-05-04T19:33:03Z

All good to merge?

danbroooks · 2021-05-04T19:45:17Z

Yeah all good 👍 I'm happy to do the merge/conflict resolution into persistent-2.13 if you want (I can do it straight after this PR is merged if it is going in now), I'm also happy to leave it to you 😄

parsonsmatt · 2021-05-04T21:26:41Z

That would be really helpful, thank you 🙌🏻

danbroooks added 4 commits April 28, 2021 20:49

Add a test, but don't use ticked types

d3ca561

Tick those types

506563c

Refactor to use lambda case

5638595

Satisfy ticket

7e141b9

danbroooks changed the title ~~1166 ticked types~~ Support promoted types in Quasi Quoter Apr 28, 2021

danbroooks commented Apr 28, 2021

View reviewed changes

Support older GHC

fc01faa

parsonsmatt requested changes May 4, 2021

View reviewed changes

danbroooks marked this pull request as ready for review May 4, 2021 17:59

Post review tweaks

2e11e0b

- Correct instances for MoneyAmount - Add some additional compiler checks to spec - Removed commented out code - Remove redundant logic in mEmbedded

danbroooks force-pushed the 1166-ticked-types branch from 61b5361 to 2e11e0b Compare May 4, 2021 18:25

Update changelog

baa3848

parsonsmatt approved these changes May 4, 2021

View reviewed changes

parsonsmatt merged commit cb7283f into yesodweb:master May 4, 2021

danbroooks mentioned this pull request May 4, 2021

Integrate #1258 into the persistent-2.13 branch #1261

Merged

7 tasks

danbroooks deleted the 1166-ticked-types branch May 5, 2021 16:24

Support promoted types in Quasi Quoter #1258

Support promoted types in Quasi Quoter #1258

Uh oh!

Conversation

danbroooks commented Apr 28, 2021 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

parsonsmatt left a comment

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

parsonsmatt left a comment

Choose a reason for hiding this comment

Uh oh!

parsonsmatt commented May 4, 2021

Uh oh!

danbroooks commented May 4, 2021

Uh oh!

parsonsmatt commented May 4, 2021

Uh oh!

Reviewers

Assignees

Labels

Projects

Milestone

Development

Uh oh!

2 participants

danbroooks commented Apr 28, 2021 •

edited

Loading