From e2a77b7310fb5a0199239e0542e96fdeb0f4b02b Mon Sep 17 00:00:00 2001
From: Shane <shane.obrien@circuithub.com>
Date: Mon, 24 Apr 2023 12:03:01 +0100
Subject: [PATCH] Passing `pure` to `withExplicit` is invalid; `materialize`
 needs to take a function (#231)

---
 src/Rel8/Query/Materialize.hs | 12 +++++++++---
 src/Rel8/Tabulate.hs          |  8 ++++----
 2 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/src/Rel8/Query/Materialize.hs b/src/Rel8/Query/Materialize.hs
index 77d6eab5..506bab4f 100644
--- a/src/Rel8/Query/Materialize.hs
+++ b/src/Rel8/Query/Materialize.hs
@@ -14,6 +14,7 @@ import Opaleye.With ( withExplicit )
 import Rel8.Expr ( Expr )
 import Rel8.Query ( Query )
 import Rel8.Query.Opaleye ( fromOpaleye, toOpaleye )
+import Rel8.Query.Rebind ( rebind )
 import Rel8.Table ( Table )
 import Rel8.Table.Opaleye ( unpackspec )
 
@@ -32,6 +33,11 @@ import Rel8.Table.Opaleye ( unpackspec )
 -- 'materialize' to use the newer @WITH foo AS MATERIALIZED bar@ syntax
 -- introduced in PostgreSQL 12 in the future. Currently Rel8 does not use
 -- @AS MATERIALIZED@ to support earlier PostgreSQL versions.
-materialize :: Table Expr a => Query a -> Query (Query a)
-materialize query = fromOpaleye $
-  withExplicit unpackspec (toOpaleye query) (pure . fromOpaleye)
+materialize :: Table Expr a => Query a -> (Query a -> Query b) -> Query b
+materialize query f =
+  fromOpaleye $
+    withExplicit unpackspec
+      (toOpaleye query')
+      (toOpaleye . f . fromOpaleye)
+  where
+    query' = query >>= rebind "with"
diff --git a/src/Rel8/Tabulate.hs b/src/Rel8/Tabulate.hs
index 49126fb5..666ac3e4 100644
--- a/src/Rel8/Tabulate.hs
+++ b/src/Rel8/Tabulate.hs
@@ -636,13 +636,13 @@ difference a b = a <* absent b
 
 -- | 'Q.materialize' for 'Tabulation's.
 materialize :: (Table Expr k, Table Expr a)
-  => Tabulation k a -> Query (Tabulation k a)
-materialize tabulation = case peek tabulation of
+  => Tabulation k a -> (Tabulation k a -> Query b) -> Query b
+materialize tabulation f = case peek tabulation of
   Tabulation query -> do
     (_, equery) <- query mempty
     case equery of
-      Left as -> liftQuery <$> Q.materialize as
-      Right kas -> fromQuery <$> Q.materialize kas
+      Left as -> Q.materialize as (f . liftQuery)
+      Right kas -> Q.materialize kas (f . fromQuery)
 
 
 -- | 'Tabulation's can be produced with either 'fromQuery' or 'liftQuery', and