Implement rawSql as a QuasiQuoter #717

felixSchl · 2017-10-12T03:42:53Z

I'm having a go at #716, now you can do:

let lft = 10 :: Int
     rgt = 20 :: Int
     width = 50 :: Int
[executeQQ|
    DELETE FROM category WHERE lft BETWEEN #{lft} AND #{rgt};
    UPDATE category SET rgt = rgt - #{width} WHERE rgt > #{rgt};
    UPDATE category SET lft = lft - #{width} WHERE lft > #{rgt};
|]

Would be great if you could help me figure out how to pass a function into makeExpr so that I don't have to duplicate the whole block of code:

https://github.com/felixSchl/persistent/blob/7856bd3878aadb9a703360d76934a7b7e78c66a4/persistent/Database/Persist/Sql/Raw/QQ.hs#L37-L49

I've also updated the test bed to include a few basic tests for this:

https://github.com/felixSchl/persistent/blob/7856bd3878aadb9a703360d76934a7b7e78c66a4/persistent-test/src/PersistentTest.hs#L891-L913

cdepillabout · 2017-10-17T18:28:15Z

@felixSchl Something like this should work:

makeExpr :: TH.ExpQ -> [StringPart] -> TH.ExpQ
makeExpr f s = TH.appE [| uncurry $(f) . first pack |] (go s)
    where
    go [] = [| (mempty, []) |]
    go (Literal a:xs)   = TH.appE [| first (a ++) |] (go xs)
    go (AntiQuote a:xs) = TH.appE [| first ("?" ++) . second (toPersistValue $(reify a) :) |] (go xs)

sqlQQ :: QuasiQuoter
sqlQQ = QuasiQuoter
    (makeExpr [| Raw.rawSql |] . parseStr [] . filter (/= '\r'))
    (error "Cannot use qc as a pattern")
    (error "Cannot use qc as a type")
    (error "Cannot use qc as a dec")

executeQQ :: QuasiQuoter
executeQQ = QuasiQuoter
    (makeExpr [| Raw.rawExecute |] . parseStr [] . filter (/= '\r'))
    (error "Cannot use qc as a pattern")
    (error "Cannot use qc as a type")
    (error "Cannot use qc as a dec")

The problem is that you effectively want to pass a template haskell Name to makeExpr, instead of a regular function. The code is arguably the cleanest if you package this Name up in an Q Exp within executeQQ and sqlQQ (instead of just passing a raw Name). makeExpr can easily make use of this Q Exp representing the function you want to call.

Also, it would be really nice to have some documentation for the sqlQQ and executeQQ functions. As an end-user, it's hard to use quasiquoters (and template-haskell stuff in general) if you don't know the types of the code being generated. That is to say, the haddocks should explicitly state that rawSql produces a value of type (RawSql a, MonadIO m) => ReaderT SqlBackend m [a] (I think?).

Also a small example in the haddocks would probably help.

felixSchl · 2017-10-17T19:44:38Z

Thanks @cdepillabout I managed to implement your advice, but I have doubts about the readability of this

https://github.com/felixSchl/persistent/blob/79804b88bc7f19c424cb57a06b6e1b085f0f7c9d/persistent/Database/Persist/Sql/Raw/QQ.hs#L37-L42

Still better than duplicate code I guess.

The transform is really, really simple. It just substitutes all #{foo} with question marks and collects them into a list. For simplicity it also applies toPersistValue on each value, but that could be removed. It then simply applies rawSql or rawExecute to the substituted string and collected values

felixSchl · 2017-10-17T20:07:07Z

@cdepillabout This is my first feature contribution to a Haskell project. Would you be able to advise me how / where to put that documentation?

cdepillabout · 2017-10-18T01:36:09Z

persistent/Database/Persist/Sql/Raw/QQ.hs

+parseStr a (x:xs)       = parseStr (x:a) xs
+
+makeExpr :: TH.Q TH.Exp -> [StringPart] -> TH.ExpQ
+makeExpr n s = TH.appE (TH.appE [| flip (.) (first pack) |] (TH.appE [| uncurry |] n)) (go s)


Thanks @cdepillabout I managed to implement your advice, but I have doubts about the readability of this

Yeah, I think you're right. I haven't taken a hard look at the code, but it seems like you might not need to split the (frist pack) and uncurry stuff into two separate expressions?

Would something like the following work? I've checked to make sure that this compiles, although I'm not sure if it passes the tests:

makeExpr :: TH.ExpQ -> [StringPart] -> TH.ExpQ makeExpr f s = TH.appE [| uncurry $(f) . first pack |] (go s) where go [] = [| (mempty, []) |] go (Literal a:xs) = TH.appE [| first (a ++) |] (go xs) go (AntiQuote a:xs) = TH.appE [| first ("?" ++) . second (toPersistValue $(reify a) :) |] (go xs)

Or maybe you could even throw the go function inside the quasiquotes:

makeExpr :: TH.ExpQ -> [StringPart] -> TH.ExpQ makeExpr f s = [| uncurry $(f) $ first pack ( $(go s) ) |] where go [] = [| (mempty, []) |] go (Literal a:xs) = TH.appE [| first (a ++) |] (go xs) go (AntiQuote a:xs) = TH.appE [| first ("?" ++) . second (toPersistValue $(reify a) :) |] (go xs)

cdepillabout · 2017-10-18T01:49:42Z

@felixSchl

The transform is really, really simple. It just substitutes all #{foo} with question marks and collects them into a list. For simplicity it also applies toPersistValue on each value, but that could be removed. It then simply applies rawSql or rawExecute to the substituted string and collected values

Yeah, from looking at your example in the first comment, it does look like a very simple transformation. I was trying to say that it would be nice to have haddocks showing the type of the value produced by sqlQQ. You'll have to use the haddock syntax to write this.

Here's an example of what I'm thinking about (using your explanation):

-- | This is a quasiquoter for creating raw SQL expressions.
--
-- It substitutes all @#{foo}@ with question marks and collects them into a list. It applies
-- 'toPersistValue' on each value. It then simply applies 'rawSql' or 'rawExecute' to the
-- substituted string and collected values.
--
-- It produces a value of type 
-- @('RawSql' a, 'MonadIO' m) => 'ReaderT' 'SqlBackend' m [a]@.
--
-- Here is a small example:
--
-- @
--    let lft = 10 :: Int
--        rgt = 20 :: Int
--        width = 50 :: Int
--    in [sqlQQ|
--            DELETE FROM category WHERE lft BETWEEN #{lft} AND #{rgt};
--            UPDATE category SET rgt = rgt - #{width} WHERE rgt > #{rgt};
--            UPDATE category SET lft = lft - #{width} WHERE lft > #{rgt};
--            |]
-- @
sqlQQ :: QuasiQuoter
sqlQQ = QuasiQuoter ...

This is my first feature contribution to a Haskell project.

Thanks a lot for your contribution! It is very much appreciated. 👍 (Although keep in mind I am not a maintainer for persistent. I just happened to be clicking around on github and realized I knew how to reduce the code duplication in makeExpr. You'll have to wait for a response from someone like @gregwebs or @snoyberg.)

felixSchl · 2017-10-24T02:20:39Z

I am still keen to work on this, but I am also somewhat complacent because I was able to simple copy that code into a module for my project, so before proceeding would be great to hear the maintainers' opinions on where this PR should go.

paul-rouse · 2017-10-24T10:40:18Z

Sorry, I'll help with it - we were probably all waiting to see if one of the other maintainers was more interested than ourselves:smile:

I don't see any problem with this, especially since it is almost all in a new module. Could you please have a look at these things - I know a list looks daunting, but they should all be easy:

There is still an outstanding comment in the code diffs about first pack and uncurry - I think you should make that change, assuming it works.
Add haddock documentation. At the module level, it would be good to show the intended usage, including something like your example from above. Please also include @since comments in both the module and function docs (assume the new version will be 2.7.2).
Bump the version in the cabal file, and add a ChangeLog entry.

I'll check it again when you've done those things. Thanks for the PR!

felixSchl · 2017-10-30T00:12:27Z

I've made all the changes and simplified even further. I hope documenting each function becomes somewhat irrelevant now:

-- | Analoguous to 'Database.Persist.Sql.Raw.rawSql'
-- @since 2.7.2
sqlQQ :: QuasiQuoter
sqlQQ = makeQQ [| rawSql |]

I haven't had time to run the tests locally, let's see what CI says. Also, @paul-rouse, I was not sure where to put the @since attribute in the module docs, top, bottom, after description? Seems random

paul-rouse · 2017-10-30T15:01:25Z

Thanks for continuing to work on this! The test failure is due to a weakness in the tests themselves, but I would like to see a clean run - give me a day or two, and I'll try to sort them out. So far my attempts have only managed to produce a bug report against the latest pre-release version of stack ...

felixSchl · 2017-10-30T15:36:11Z

Awesome, thanks. I actually hit another uncovered usecase just minutes ago:

updateItemsInCart products cartPk = do
  escape <- connEscapeName <$> ask

  let tbl          = escape $ entityDB $ entityDef (Nothing :: Maybe CartItem)
      cartIdCol    = escape $ fieldDB  $ persistFieldDef CartItemCartId
      productIdCol = escape $ fieldDB  $ persistFieldDef CartItemProductId
      qtyCol       = escape $ fieldDB  $ persistFieldDef CartItemQuantity

  -- update the items
  forM_ products $ \(productPk, qty) ->
    if N.unpack qty <= 0
      then deleteBy $ CartItemUniqueCartIdProductId cartPk productPk
      else
        [executeQQ|
          INSERT INTO #{tbl} (#{cartIdCol}, #{productIdCol}, #{qtyCol})
          VALUES (#{cartPk}, #{productPk}, #{qty})
          ON CONFLICT (#{cartIdCol}, #{productIdCol})
          DO UPDATE SET
            #{qtyCol} = EXCLUDED.#{qtyCol}
        |]

This generates the following query:

[Debug#SQL] 
          INSERT INTO ? (?, ?, ?)
          VALUES (?, ?, ?)
          ON CONFLICT (?, ?)
          DO UPDATE SET
            ? = EXCLUDED.?

But my intention was:

[Debug#SQL] 
          INSERT INTO "cart_item" ("cart_id", "product_id", "quantity")
          VALUES (?, ?, ?)
          ON CONFLICT ("cart_id", "product_id", "quantity")
          DO UPDATE SET
            ? = EXCLUDED.?

felixSchl · 2017-10-30T16:10:45Z

I think it would be cool if this was possible:

  forM_ products $ \(productPk, qty) ->
    if N.unpack qty <= 0
      then deleteBy $ CartItemUniqueCartIdProductId cartPk productPk
      else
        [executeQQ|
          INSERT INTO ^{CartItem} (@{CartItemCardId}, @{CartItemProductId}, @{CartItemQuantity})
          VALUES (#{cartPk}, #{productPk}, #{qty})
          ON CONFLICT (@{CartItemCardId}, @{CartItemProductId})
          DO UPDATE SET
            @{CartItemQuantity} = EXCLUDED.@{CartItemQuantity}
        |]

So ^{...} does table references, @{...} does column references and #{...} continues to do value substitutions. It's all possible because we are in the ReaderT, so connEscapeName <$> ask should be possible to generate, but I ran into staging issues when trying to pass the escape function to go..

At least doing it this way "somewhat" type checks the program and makes sure things are escaped automatically.

Fix tests to allow testing #717

paul-rouse · 2017-11-01T13:21:01Z

I have fixed the travis tests in master to work around the problem meeting the requirement for happy in the lts-2 case, so I think they should work next time you push a commit in this PR. However, when I ran them in my own fork, plus your patch, I got a different error in the lts-2 case, and this is one you need to look at: example log.

felixSchl · 2017-11-01T21:37:53Z

Hm, not sure how to fix the mempty error. If I include it explicitly import Data.Monoid (mempty), it fails to compile on lts-6 and suggests "Perhaps you meant this: import Data.Monoid ()" which in turn does not work on lts-2 again.

paul-rouse · 2017-11-01T22:08:33Z

The compiler's suggestion is misleading in this case - you really do need import Data.Monoid (mempty) for lts-2.

In this project, all compiler warnings are switched on and are treated as errors, which is quite strict! Of course the problem in your QQ.hs module is that the Prelude in base-4.7 didn't export the Monoid stuff, but from base-4.8 onwards it does, making the explicit import redundant. Since we know what we are doing (:smile:) it is simplest to just silence the warning:

{-# OPTIONS_GHC -fno-warn-unused-imports #-}
...
import Data.Monoid (mappend)

felixSchl · 2017-11-01T22:11:22Z

Does that suggest I could do import Prelude hiding (mempty) and later import Data.Monoid (mempty). A bit awkward though without the context :)

paul-rouse · 2017-11-01T22:19:31Z

I think import Prelude hiding (mempty) will complain in lts-2, when mempty is not exported by Prelude

felixSchl · 2017-11-01T22:22:05Z

Ah yeah, of course. Hopefully this round of CI will pass. Did you have any response to the previous comments I made (interpolating table and column names)? I think that would be really cool to have, but I still haven't worked out how to do to the fmap connEscapeName ask >>= \escape -> dance inside TH.

paul-rouse · 2017-11-01T22:35:30Z

I can certainly see the benefit of having a syntax to interpolate table and column names. It is up to you - if you want to work that out now, then I'll wait for it; otherwise, if you prefer, I can merge this version and you can submit a separate PR when you are ready to extend it with the other types of substitution. Of course that assumes that the extended version would not break anything you have already done here.

felixSchl · 2017-11-01T22:36:45Z

I don't see how it would break anything as the types don't have to change and the syntax is only extended. But if you bear with me, I'd like to give it another go before hand off

paul-rouse · 2017-11-01T22:38:26Z

OK, I'll wait for you to say!

This introduces a bit more complexity into the Quasi Quoter but makes sure that no unused patterns are introduced if they are not needed

felixSchl · 2017-11-09T23:56:05Z

Not sure what's going on there but it seems the tests are failing for reasons other than the actual code changes, looks it's having trouble fetching some dependencies for the old lts2.2 https://travis-ci.org/yesodweb/persistent/jobs/299921263

paul-rouse · 2017-11-10T07:53:08Z

I restarted that test, and it is OK now.

Sorry to be a pain - could you add a link to the PR in ChangeLog.md, please, to be consistent with other recent entries?

felixSchl · 2017-11-10T07:55:49Z

Oh sorry, yeah will do

…

On 10/11/2017 20:53, "Paul Rouse" ***@***.***> wrote: I restarted that test, and it is OK now. Sorry to be a pain - could you add a link to the PR in ChangeLog.md, please, to be consistent with other recent entries? — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <#717 (comment)>, or mute the thread <https://github.com/notifications/unsubscribe-auth/ACk_zjHHAz3NPGdoWgep_OPl2peDbysIks5s1ADlgaJpZM4P2bUD> .

felixSchl · 2017-11-10T16:53:25Z

Alright, updated and CI still OK :)

paul-rouse · 2017-11-10T17:51:50Z

Great! Thanks for all of your work on this!

Rearrange documentation added in #717

felixSchl force-pushed the feature/rawsqlQQ branch from 7856bd3 to 4732b34 Compare October 14, 2017 15:06

cdepillabout approved these changes Oct 18, 2017

View reviewed changes

felixSchl force-pushed the feature/rawsqlQQ branch from d764f99 to cd36f01 Compare October 30, 2017 00:10

felixSchl force-pushed the feature/rawsqlQQ branch from 8fd8b2e to 9969bb2 Compare October 30, 2017 00:48

paul-rouse added a commit to paul-rouse/persistent that referenced this pull request Nov 1, 2017

Fix tests to allow testing yesodweb#717

82ad446

paul-rouse mentioned this pull request Nov 1, 2017

Fix tests to allow testing #717 #728

Merged

paul-rouse added a commit that referenced this pull request Nov 1, 2017

Merge pull request #728 from paul-rouse/master

ad8c46d

Fix tests to allow testing #717

felixSchl force-pushed the feature/rawsqlQQ branch from 2c7e7aa to 915e6c1 Compare November 1, 2017 16:59

felixSchl force-pushed the feature/rawsqlQQ branch from 915e6c1 to 2d411bd Compare November 1, 2017 22:13

felixSchl force-pushed the feature/rawsqlQQ branch 2 times, most recently from 27f0aa0 to 277c35d Compare November 2, 2017 05:49

felixSchl and others added 13 commits November 10, 2017 11:31

Simplify further, wrap more functions and add docs

ded757c

Explicitly import mempty

42114af

Implement table and column name escaping

1c5bca3

Update module level docs

d894801

Update docs and avoid introducing unused var

0d1e9db

This introduces a bit more complexity into the Quasi Quoter but makes sure that no unused patterns are introduced if they are not needed

Add tests for column and table name interpolation

f5dff51

Use getFieldName and getTableName in QQ

30f3f7d

Add more sqlQQ tests

6851e49

Add fail as a package dependency to persistent

487209b

Add getFieldName and getTableName imports

a96a343

Use the Monad fail function

2c307ac

Use return instead of pure

e38e223

Explicitly annotate runQuery in tests

8fdf10a

felixSchl force-pushed the feature/rawsqlQQ branch 2 times, most recently from eb6c7b8 to e712678 Compare November 9, 2017 23:26

felixSchl force-pushed the feature/rawsqlQQ branch from e712678 to 126fabc Compare November 10, 2017 15:50

Update persistent ChangeLog

2e88e2e

felixSchl force-pushed the feature/rawsqlQQ branch from 126fabc to 2e88e2e Compare November 10, 2017 15:52

paul-rouse merged commit 0b8c716 into yesodweb:master Nov 10, 2017

paul-rouse mentioned this pull request Nov 21, 2017

Feature request: Named parameter substitutions in rawSql #716

Closed

paul-rouse added a commit to paul-rouse/persistent that referenced this pull request Nov 25, 2017

Rearrange documentation added in yesodweb#717

900d4d3

paul-rouse mentioned this pull request Nov 25, 2017

Rearrange documentation added in #717 #737

Merged

paul-rouse added a commit that referenced this pull request Nov 25, 2017

Merge pull request #737 from paul-rouse/master

b97f50a

Rearrange documentation added in #717

naushadh mentioned this pull request Jan 6, 2018

Performance enhancements for bulk writes. #770

Merged

snoyberg mentioned this pull request Aug 23, 2018

haskell-src-meta is a heavyweight dependency #827

Closed

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Implement rawSql as a QuasiQuoter #717

Implement rawSql as a QuasiQuoter #717

felixSchl commented Oct 12, 2017

cdepillabout commented Oct 17, 2017

felixSchl commented Oct 17, 2017 •

edited

Loading

felixSchl commented Oct 17, 2017

cdepillabout Oct 18, 2017

cdepillabout commented Oct 18, 2017 •

edited

Loading

felixSchl commented Oct 24, 2017

paul-rouse commented Oct 24, 2017

felixSchl commented Oct 30, 2017

paul-rouse commented Oct 30, 2017

felixSchl commented Oct 30, 2017

felixSchl commented Oct 30, 2017 •

edited

Loading

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017 •

edited

Loading

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 9, 2017

paul-rouse commented Nov 10, 2017

felixSchl commented Nov 10, 2017 via email

felixSchl commented Nov 10, 2017

paul-rouse commented Nov 10, 2017

Implement rawSql as a QuasiQuoter #717

Implement rawSql as a QuasiQuoter #717

Conversation

felixSchl commented Oct 12, 2017

cdepillabout commented Oct 17, 2017

felixSchl commented Oct 17, 2017 • edited Loading

felixSchl commented Oct 17, 2017

cdepillabout Oct 18, 2017

Choose a reason for hiding this comment

cdepillabout commented Oct 18, 2017 • edited Loading

felixSchl commented Oct 24, 2017

paul-rouse commented Oct 24, 2017

felixSchl commented Oct 30, 2017

paul-rouse commented Oct 30, 2017

felixSchl commented Oct 30, 2017

felixSchl commented Oct 30, 2017 • edited Loading

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017 • edited Loading

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 1, 2017

paul-rouse commented Nov 1, 2017

felixSchl commented Nov 9, 2017

paul-rouse commented Nov 10, 2017

felixSchl commented Nov 10, 2017 via email

felixSchl commented Nov 10, 2017

paul-rouse commented Nov 10, 2017

felixSchl commented Oct 17, 2017 •

edited

Loading

cdepillabout commented Oct 18, 2017 •

edited

Loading

felixSchl commented Oct 30, 2017 •

edited

Loading

felixSchl commented Nov 1, 2017 •

edited

Loading