Add SQL QQ variants supporting anti-quotation of arbitrary Haskell expressions

ChangeLog.md

@@ -9,10 +9,11 @@ This project's release branch is `master`. This log is written from the perspect
 
 ## 2019-08-02 - Unreleased
 
-* Remove `Rhyolite.Backend.Snap`. That module has been made obsolete by Obelisk. 
+* Remove `Rhyolite.Backend.Snap`. That module has been made obsolete by Obelisk.
 * Frontend.App: Use reflex's `matchResponsesWithRequests` instead of `identifyTags` (now deleted). Change the identifier used by `TaggedRequest` and `TaggedResponse` to an `Int`
 * Remove `mapRequesterT`. This has been upstreamed to reflex as `withRequesterT`
 * Remove Frontend.Request and Frontend.WebSocket
+* Add SQL QuasiQuote variants supporting anti-quotation of arbitrary Haskell expressions (`Rhyolite.Backend.DB.PsqlSimple.queryQi` et al.)
 
 ## 2019-08-01 - Unreleased
 

backend-db/Rhyolite/Backend/DB/PsqlSimple.hs

@@ -20,6 +20,7 @@ module Rhyolite.Backend.DB.PsqlSimple
   , Query (..), sql, traceQuery, traceExecute, traceExecute_
   , liftWithConn
   , queryQ, executeQ, executeQ_, sqlQ, traceQueryQ, traceExecuteQ, traceExecuteQ_
+  , queryQi, executeQi, executeQi_, traceQueryQi, traceExecuteQi, traceExecuteQi_
   , fromIdRow
   ) where
 
@@ -38,6 +39,7 @@ import qualified Database.PostgreSQL.Simple as Sql
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.FromRow (FromRow, RowParser, fromRow)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.SqlQQ.Interpolated (quoteInterpolatedSql)
 import Database.PostgreSQL.Simple.ToField (ToField, toField, Action)
 import Database.PostgreSQL.Simple.ToRow (ToRow, toRow)
 import Database.PostgreSQL.Simple.Types ((:.), Binary, In (..), Only (..), PGArray (..), Query, Values (..),
@@ -248,3 +250,31 @@ extractVars = extractVars'
 
 fromIdRow :: (Only (Id v) :. v) -> (Id v, v)
 fromIdRow (Only k Sql.:. v) = (k, v)
+
+
+-- | Same as 'query' but replaces anything of the form @${haskell-expr}@ with @?@ in the
+-- statement and passes it as a statement parameter.
+queryQi :: QuasiQuoter
+queryQi = (defaultQQ "queryQ") { quoteExp = appE [| uncurry query |] . quoteInterpolatedSql }
+
+-- | Same as 'execute' but replaces anything of the form @${haskell-expr}@ with @?@ in the
+-- statement and passes it as a statement parameter.
+executeQi :: QuasiQuoter
+executeQi = (defaultQQ "executeQ") { quoteExp = appE [| uncurry execute |] . quoteInterpolatedSql }
+
+-- | Same as 'execute_' but replaces anything of the form @${haskell-expr}@ with @?@ in the
+-- statement and passes it as a statement parameter.
+executeQi_ :: QuasiQuoter
+executeQi_ = (defaultQQ "executeQ_") { quoteExp = appE [| uncurry execute_ |] . quoteInterpolatedSql }
+
+-- | Same as 'queryQi' but uses 'traceQuery' instead of 'query'.
+traceQueryQi :: QuasiQuoter
+traceQueryQi = (defaultQQ "traceQueryQ") { quoteExp = appE [| uncurry traceQuery |] . quoteInterpolatedSql }
+
+-- | Same as 'executeQi' but uses 'traceExecute' instead of 'execute'.
+traceExecuteQi :: QuasiQuoter
+traceExecuteQi = (defaultQQ "traceExecuteQ") { quoteExp = appE [| uncurry traceExecute |] . quoteInterpolatedSql }
+
+-- | Same as 'executeQi_' but uses 'traceExecute_' instead of 'execute_'.
+traceExecuteQi_ :: QuasiQuoter
+traceExecuteQi_ = (defaultQQ "traceExecuteQ_") { quoteExp = appE [| uncurry traceExecute_ |] . quoteInterpolatedSql }

backend-db/rhyolite-backend-db.cabal

@@ -32,6 +32,7 @@ library
     , monoidal-containers
     , mtl
     , postgresql-simple
+    , postgresql-simple-interpolate
     , postgresql-lo-stream
     , push-notifications
     , resource-pool

default.nix

@@ -34,6 +34,7 @@ let
     groundhog-th = repos.groundhog + /groundhog-th;
     monoidal-containers = repos.monoidal-containers;
     postgresql-lo-stream = repos.postgresql-lo-stream;
+    postgresql-simple-interpolate = repos.postgresql-simple-interpolate;
     # Newer versions than those in reflex-platform
     gargoyle = repos.gargoyle + /gargoyle;
     gargoyle-postgresql = repos.gargoyle + /gargoyle-postgresql;

dep/postgresql-simple-interpolate/default.nix

@@ -0,0 +1,7 @@
+# DO NOT HAND-EDIT THIS FILE
+import ((import <nixpkgs> {}).fetchFromGitHub (
+  let json = builtins.fromJSON (builtins.readFile ./github.json);
+  in { inherit (json) owner repo rev sha256;
+       private = json.private or false;
+     }
+))

dep/postgresql-simple-interpolate/github.json

@@ -0,0 +1,7 @@
+{
+  "owner": "3noch",
+  "repo": "postgresql-simple-interpolate",
+  "branch": "master",
+  "rev": "861cf54808f575e27ea1ad220eab9d5a1e9fec00",
+  "sha256": "0gz700vj7sfbq55m5ziqicdj14asygjpkf0rypc9nr7f66qr9vq7"
+}