From 29f1fdd458afef997c0c8ae7e1a4443a65efc86b Mon Sep 17 00:00:00 2001
From: Ollie Charles <oliver.charles@circuithub.com>
Date: Tue, 22 Sep 2020 08:57:54 +0100
Subject: [PATCH] Drop use of QueryArr (#15)

---
 Rel8.hs        | 50 +++++---------------------------------------------
 doc/Example.hs | 27 ---------------------------
 2 files changed, 5 insertions(+), 72 deletions(-)

diff --git a/Rel8.hs b/Rel8.hs
index 5abf540..3f65750 100644
--- a/Rel8.hs
+++ b/Rel8.hs
@@ -28,10 +28,9 @@ module Rel8
   , Table
 
     -- * Querying Tables
-  , O.Query, O.QueryArr
+  , O.Query
   , queryTable
   , leftJoin
-  , leftJoinA
   , fullJoin
   , unionAll
   , exceptAll
@@ -126,6 +125,7 @@ module Rel8
   ) where
 
 import Control.Applicative (liftA2)
+import Control.Arrow (app)
 import Control.Category ((.), id)
 import Control.Monad.Rel8
 import Data.List (foldl')
@@ -142,10 +142,7 @@ import qualified Opaleye.Internal.Distinct as O
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as O
 import qualified Opaleye.Internal.Join as O
 import qualified Opaleye.Internal.PackMap as O
-import qualified Opaleye.Internal.PrimQuery as PrimQuery
 import qualified Opaleye.Internal.QueryArr as O
-import qualified Opaleye.Internal.Tag as O
-import qualified Opaleye.Internal.Unpackspec as O
 import qualified Opaleye.Join as O
 import qualified Opaleye.Operators as O
 import qualified Opaleye.Order as O
@@ -215,43 +212,6 @@ leftJoin condition l r =
     (\(a, (_, b)) -> exprToColumn (toNullable (condition a b)))
 
 
---------------------------------------------------------------------------------
--- | A more convenient form of 'leftJoin' when using arrow notation.
--- @inlineLeftJoinA@ takes the left join of all proceeding queries against a
--- given query. The input to the 'QueryArr' is a predicate function against
--- rows in the to-be-joined query.
---
--- === Example
--- @
--- -- Return all users and comments, including users who haven't made a comment.
--- usersAndComments :: Query (User Expr, MaybeTable (Comment Expr))
--- proc _ -> do
---   u <- queryTable -< ()
---   comment <- inlineLeftJoinA -< \c -> commentUser c ==. userId u
---   returnA (u, c)
--- @
-leftJoinA
-  :: (Table a haskell, Predicate bool)
-  => O.Query a -> O.QueryArr (a -> Expr bool) (MaybeTable a)
-leftJoinA q =
-  O.QueryArr $ \(p, left, t) ->
-    let O.QueryArr rightQueryF = liftA2 (,) (pure (lit (Just False))) q
-        (right, pqR, t') = rightQueryF ((), PrimQuery.Unit, t)
-        ((tag, renamed), ljPEsB) =
-          O.run
-            (O.runUnpackspec unpackColumns (O.extractLeftJoinFields 2 t') right)
-    in ( MaybeTable tag renamed
-       , PrimQuery.Join
-           PrimQuery.LeftJoin
-           (case toNullable (p renamed) of
-              Expr a -> a)
-           [] -- TODO ?
-           ljPEsB
-           left
-           pqR
-       , O.next t')
-
-
 --------------------------------------------------------------------------------
 -- | Take the @FULL OUTER JOIN@ of two queries.
 fullJoin
@@ -280,15 +240,15 @@ distinct =
        (O.Aggregator (O.PackMap (\f -> traversePrimExprs (\e -> f (Nothing,e))))))
 
 -- | Restrict a 'O.QueryArr' to only contain rows that satisfy a given predicate.
-where_ :: Predicate bool => O.QueryArr (Expr bool) ()
-where_ = lmap (exprToColumn . toNullable) O.restrict
+where_ :: Predicate bool => Expr bool -> O.Query ()
+where_ x = lmap (const (exprToColumn (toNullable x))) O.restrict
 
 -- | Filter a 'O.Query' into a new query where all rows satisfy a given
 -- predicate.
 filterQuery :: Predicate bool => (a -> Expr bool) -> O.Query a -> O.Query a
 filterQuery f q = proc _ -> do
   row <- q -< ()
-  where_ -< f row
+  app -< (where_ (f row), ())
   id -< row
 
 -- | Corresponds to the @IS NULL@ operator.
diff --git a/doc/Example.hs b/doc/Example.hs
index 9479ca4..01ef583 100644
--- a/doc/Example.hs
+++ b/doc/Example.hs
@@ -58,20 +58,6 @@ allPartCities = partCity <$> allParts
 londonParts :: Query (Part Expr)
 londonParts = filterQuery (\p -> partCity p ==. "London") allParts
 
-heavyParts :: Query (Part Expr)
-heavyParts = proc _ -> do
-  part <- queryTable -< ()
-  where_ -< partWeight part >. 5
-  returnA -< part
-
-existsExample :: Query (Part Expr)
-existsExample = proc _ -> do
-  part <- queryTable -< ()
-  (| restrictExists
-       (do otherPart <- queryTable -< ()
-           where_ -< partWeight otherPart >. partWeight part) |)
-  returnA -< part
-
 data Supplier f = Supplier
   { supplierId :: C f "SID" 'HasDefault Int32
   , supplierName :: C f "SName" 'NoDefault String
@@ -98,19 +84,6 @@ partsAndSuppliers =
     (\(part, supplier) -> partCity part ==. supplierCity supplier)
     allPartsAndSuppliers
 
-partsAndSuppliersLJ :: Query (Part Expr, MaybeTable (Supplier Expr))
-partsAndSuppliersLJ = proc _ -> do
-  part <- queryTable -< ()
-  maybeSupplier <- leftJoinA queryTable -<
-    \supplier -> partCity part ==. supplierCity supplier
-  returnA -< (part, maybeSupplier)
-
-partsWithoutSuppliersInCity :: Query (Part Expr)
-partsWithoutSuppliersInCity = proc _ -> do
-  (part, maybeSupplier) <- partsAndSuppliersLJ -< ()
-  where_ -< isNull (supplierId $? maybeSupplier)
-  returnA -< part
-
 --------------------------------------------------------------------------------
 main :: IO ()
 main = return ()