diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,16 @@
+## 0.9.1.0
+
+* Added `distinctOnExplicit` and `distinctOnByExplicit`
+
+* Added `label'` as a future replacement for `label`
+
+* Exported `SqlFractional` from `Opaleye.SqlTypes`
+
+* Fixed [a bug in
+  `forUpdate`](https://github.com/tomjaguarpaw/haskell-opaleye/issues/540)
+
+* The internal implementation of `QueryArr` has changed.
+
 ## 0.9.0.0
 
 The switch from `Column` to `Field` is complete.  This is a small yet
diff --git a/Test/Opaleye/Test/Arbitrary.hs b/Test/Opaleye/Test/Arbitrary.hs
--- a/Test/Opaleye/Test/Arbitrary.hs
+++ b/Test/Opaleye/Test/Arbitrary.hs
@@ -13,6 +13,7 @@
 import           Opaleye.Test.Fields
 
 import qualified Opaleye as O
+import qualified Opaleye.Exists as OE
 import qualified Opaleye.Join as OJ
 
 import           Control.Applicative (pure, (<$>), (<*>), liftA2)
@@ -492,6 +493,15 @@
                             . fmap listFields)
                            (O.optionalRestrictExplicit unpackFields q)
         return q'
+    , do
+        thisLabel <- TQ.arbitrary
+        pure $ \select -> do
+          O.label' thisLabel
+          select
+    , do
+        pure $ \select -> do
+          exists <- OE.exists select
+          pure (Choices [Left (CBool exists)])
     ]
 
 genSelectMapper2 :: [TQ.Gen (O.Select Fields -> O.Select Fields
@@ -515,9 +525,7 @@
 
 genSelectArrMapper :: [TQ.Gen (O.SelectArr a Fields -> O.SelectArr a Fields)]
 genSelectArrMapper =
-    [ do
-        thisLabel        <- TQ.arbitrary
-        return (O.label thisLabel)
+    [
     ]
 
 genSelectArrMaybeMapper :: [TQ.Gen (O.SelectArr a Fields
diff --git a/Test/Test.hs b/Test/Test.hs
--- a/Test/Test.hs
+++ b/Test/Test.hs
@@ -354,8 +354,8 @@
           O.restrict -< fst t .== 1
           Arr.returnA -< t
 
-testExists :: Test
-testExists = it "restricts the rows returned with EXISTS" $
+testRestrictExists :: Test
+testRestrictExists = it "restricts the rows returned with EXISTS" $
     select `selectShouldReturnSorted` filter ((== 1) . fst) (L.sort table1data)
   where select = proc () -> do
           t <- table1Q -< ()
@@ -364,8 +364,8 @@
                             O.restrict -< fst t' .> fst t) -< t
           Arr.returnA -< t
 
-testNotExists :: Test
-testNotExists = it "restricts the rows returned with NOT EXISTS" $
+testRestrictNotExists :: Test
+testRestrictNotExists = it "restricts the rows returned with NOT EXISTS" $
     select `selectShouldReturnSorted` filter ((== 2) . fst)  (L.sort table1data)
   where select = proc () -> do
           t <- table1Q -< ()
@@ -1453,8 +1453,8 @@
         testSelect
         testProduct
         testRestrict
-        testExists
-        testNotExists
+        testRestrictExists
+        testRestrictNotExists
         testIn
         testNum
         testDiv
diff --git a/opaleye.cabal b/opaleye.cabal
--- a/opaleye.cabal
+++ b/opaleye.cabal
@@ -1,6 +1,6 @@
 name:            opaleye
 copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2022 Tom Ellis
-version:         0.9.0.0
+version:         0.9.1.0
 synopsis:        An SQL-generating DSL targeting PostgreSQL
 description:     An SQL-generating DSL targeting PostgreSQL.  Allows
                  Postgres queries to be written within Haskell in a
diff --git a/src/Opaleye/Aggregate.hs b/src/Opaleye/Aggregate.hs
--- a/src/Opaleye/Aggregate.hs
+++ b/src/Opaleye/Aggregate.hs
@@ -43,6 +43,7 @@
 import qualified Opaleye.Internal.QueryArr as Q
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
 import qualified Opaleye.Internal.PackMap as PM
+import qualified Opaleye.Internal.Tag as Tag
 
 import qualified Opaleye.Field     as F
 import qualified Opaleye.Order     as Ord
@@ -81,7 +82,10 @@
 -- See 'Opaleye.Internal.Sql.aggregate' for details of how aggregating
 -- by an empty query with no group by is handled.
 aggregate :: Aggregator a b -> S.Select a -> S.Select b
-aggregate agg q = Q.productQueryArr (A.aggregateU agg . Q.runSimpleQueryArr q)
+aggregate agg q = Q.productQueryArr' $ \() -> do
+  (a, pq) <- Q.runSimpleQueryArr' q ()
+  t <- Tag.fresh
+  pure (A.aggregateU agg (a, pq, t))
 
 -- | Order the values within each aggregation in `Aggregator` using
 -- the given ordering. This is only relevant for aggregations that
diff --git a/src/Opaleye/Exists.hs b/src/Opaleye/Exists.hs
--- a/src/Opaleye/Exists.hs
+++ b/src/Opaleye/Exists.hs
@@ -2,10 +2,10 @@
 
 import           Opaleye.Field (Field)
 import           Opaleye.Internal.Column (Field_(Column))
-import           Opaleye.Internal.QueryArr (runSimpleQueryArr, productQueryArr)
+import           Opaleye.Internal.QueryArr (productQueryArr', runSimpleQueryArr')
 import           Opaleye.Internal.PackMap (run, extractAttr)
 import           Opaleye.Internal.PrimQuery (PrimQuery' (Exists))
-import           Opaleye.Internal.Tag (next)
+import           Opaleye.Internal.Tag (fresh)
 import           Opaleye.Select (Select)
 import           Opaleye.SqlTypes (SqlBool)
 
@@ -13,9 +13,8 @@
 --
 -- This operation is equivalent to Postgres's @EXISTS@ operator.
 exists :: Select a -> Select (Field SqlBool)
-exists q = productQueryArr (f . runSimpleQueryArr q)
-  where
-    f (_, query, tag) = (Column result, Exists binding query, tag')
-      where
-        (result, [(binding, ())]) = run (extractAttr "exists" tag ())
-        tag' = next tag
+exists q = productQueryArr' $ \() -> do
+  (_, query) <- runSimpleQueryArr' q ()
+  tag <- fresh
+  let (result, [(binding, ())]) = run (extractAttr "exists" tag ())
+  pure (Column result, Exists binding query)
diff --git a/src/Opaleye/Internal/Aggregate.hs b/src/Opaleye/Internal/Aggregate.hs
--- a/src/Opaleye/Internal/Aggregate.hs
+++ b/src/Opaleye/Internal/Aggregate.hs
@@ -102,8 +102,8 @@
 -- aggregate.  On the other hand, referring to a field from a previous
 -- query in an ORDER BY expression is totally fine!
 aggregateU :: Aggregator a b
-           -> (a, PQ.PrimQuery, T.Tag) -> (b, PQ.PrimQuery, T.Tag)
-aggregateU agg (c0, primQ, t0) = (c1, primQ', T.next t0)
+           -> (a, PQ.PrimQuery, T.Tag) -> (b, PQ.PrimQuery)
+aggregateU agg (c0, primQ, t0) = (c1, primQ')
   where (c1, projPEs_inners) =
           PM.run (runAggregator agg (extractAggregateFields t0) c0)
 
diff --git a/src/Opaleye/Internal/Binary.hs b/src/Opaleye/Internal/Binary.hs
--- a/src/Opaleye/Internal/Binary.hs
+++ b/src/Opaleye/Internal/Binary.hs
@@ -40,19 +40,23 @@
 
 sameTypeBinOpHelper :: PQ.BinOp -> Binaryspec columns columns'
                     -> Q.Query columns -> Q.Query columns -> Q.Query columns'
-sameTypeBinOpHelper binop binaryspec q1 q2 = Q.productQueryArr q where
-  q ((), startTag) = (newColumns, newPrimQuery, T.next endTag)
-    where (columns1, primQuery1, midTag) = Q.runSimpleQueryArr q1 ((), startTag)
-          (columns2, primQuery2, endTag) = Q.runSimpleQueryArr q2 ((), midTag)
+sameTypeBinOpHelper binop binaryspec q1 q2 = Q.productQueryArr' $ \() -> do
+  (columns1, primQuery1) <- Q.runSimpleQueryArr' q1 ()
+  (columns2, primQuery2) <- Q.runSimpleQueryArr' q2 ()
 
-          (newColumns, pes) =
+  endTag <- T.fresh
+
+  let (newColumns, pes) =
             PM.run (runBinaryspec binaryspec (extractBinaryFields endTag)
                                     (columns1, columns2))
 
-          newPrimQuery = PQ.Binary binop
+      newPrimQuery = PQ.Binary binop
             ( PQ.Rebind False (map (fmap fst) pes) primQuery1
             , PQ.Rebind False (map (fmap snd) pes) primQuery2
             )
+
+  pure (newColumns, newPrimQuery)
+
 
 instance Default Binaryspec (Field_ n a) (Field_ n a) where
   def = binaryspecColumn
diff --git a/src/Opaleye/Internal/Join.hs b/src/Opaleye/Internal/Join.hs
--- a/src/Opaleye/Internal/Join.hs
+++ b/src/Opaleye/Internal/Join.hs
@@ -17,11 +17,9 @@
 import qualified Opaleye.SqlTypes as T
 import qualified Opaleye.Field as C
 import           Opaleye.Field   (Field)
-import qualified Opaleye.Internal.Map as Map
 import           Opaleye.Internal.MaybeFields (MaybeFields(MaybeFields),
                                                mfPresent, mfFields)
 import qualified Opaleye.Select  as S
-import qualified Opaleye.Internal.TypeFamilies as TF
 
 import qualified Control.Applicative as A
 import qualified Control.Arrow
@@ -50,39 +48,40 @@
              -> ((columnsA, columnsB) -> Field T.PGBool)
              -> Q.Query (returnedColumnsA, returnedColumnsB)
 joinExplicit uA uB returnColumnsA returnColumnsB joinType
-             qA qB cond = Q.productQueryArr q where
-  q ((), startTag) = ((nullableColumnsA, nullableColumnsB), primQueryR, T.next endTag)
-    where (columnsA, primQueryA, midTag) = Q.runSimpleQueryArr qA ((), startTag)
-          (columnsB, primQueryB, endTag) = Q.runSimpleQueryArr qB ((), midTag)
+             qA qB cond = Q.productQueryArr' $ \() -> do
+  (columnsA, primQueryA) <- Q.runSimpleQueryArr' qA ()
+  (columnsB, primQueryB) <- Q.runSimpleQueryArr' qB ()
 
-          (newColumnsA, ljPEsA) =
+  endTag <- T.fresh
+
+  let (newColumnsA, ljPEsA) =
             PM.run (U.runUnpackspec uA (extractLeftJoinFields 1 endTag) columnsA)
-          (newColumnsB, ljPEsB) =
+      (newColumnsB, ljPEsB) =
             PM.run (U.runUnpackspec uB (extractLeftJoinFields 2 endTag) columnsB)
 
-          nullableColumnsA = returnColumnsA newColumnsA
-          nullableColumnsB = returnColumnsB newColumnsB
+      nullableColumnsA = returnColumnsA newColumnsA
+      nullableColumnsB = returnColumnsB newColumnsB
 
-          Column cond' = cond (columnsA, columnsB)
-          primQueryR = PQ.Join joinType cond'
+      Column cond' = cond (columnsA, columnsB)
+      primQueryR = PQ.Join joinType cond'
                                (PQ.NonLateral, (PQ.Rebind True ljPEsA primQueryA))
                                (PQ.NonLateral, (PQ.Rebind True ljPEsB primQueryB))
 
+  pure ((nullableColumnsA, nullableColumnsB), primQueryR)
+
+
 leftJoinAExplicit :: U.Unpackspec a a
                   -> NullMaker a nullableA
                   -> Q.Query a
                   -> Q.QueryArr (a -> Field T.PGBool) nullableA
 leftJoinAExplicit uA nullmaker rq =
-  Q.leftJoinQueryArr $ \(p, t1) ->
-    let (newColumnsR, right, tag') = flip Q.runSimpleQueryArr ((), t1) $ proc () -> do
+  Q.leftJoinQueryArr' $ \p -> do
+    (newColumnsR, right) <- flip Q.runSimpleQueryArr' () $ proc () -> do
           a <- rq -< ()
           Rebind.rebindExplicit uA -< a
-        renamedNullable = toNullable nullmaker newColumnsR
+    let renamedNullable = toNullable nullmaker newColumnsR
         Column cond = p newColumnsR
-    in ( renamedNullable
-       , cond
-       , right
-       , tag')
+    pure (renamedNullable, cond, right)
 
 optionalRestrict :: D.Default U.Unpackspec a a
                  => S.Select a
diff --git a/src/Opaleye/Internal/Locking.hs b/src/Opaleye/Internal/Locking.hs
--- a/src/Opaleye/Internal/Locking.hs
+++ b/src/Opaleye/Internal/Locking.hs
@@ -21,4 +21,6 @@
 -- enforce those restrictions through its type system so it's very
 -- easy to create queries that fail at run time using this operation.
 forUpdate :: Q.Select a -> Q.Select a
-forUpdate = Q.mapPrimQuery PQ.ForUpdate
+forUpdate s = Q.productQueryArr' $ \() -> do
+  (a, query) <- Q.runSimpleQueryArr' s ()
+  pure (a, PQ.ForUpdate query)
diff --git a/src/Opaleye/Internal/MaybeFields.hs b/src/Opaleye/Internal/MaybeFields.hs
--- a/src/Opaleye/Internal/MaybeFields.hs
+++ b/src/Opaleye/Internal/MaybeFields.hs
@@ -11,7 +11,6 @@
 
 module Opaleye.Internal.MaybeFields where
 
-import           Control.Applicative hiding (optional)
 import           Control.Arrow (returnA, (<<<), (>>>))
 
 import qualified Opaleye.Internal.Binary as B
@@ -139,15 +138,15 @@
   where isNotNull = Opaleye.Internal.Operators.not . Opaleye.Field.isNull
 
 optionalInternal :: (Opaleye.Field.FieldNullable SqlBool -> a -> r) -> Select a -> Select r
-optionalInternal f query = IQ.leftJoinQueryArr $ \arg ->
+optionalInternal f query = IQ.leftJoinQueryArr' $ \() -> do
     -- This is basically a left join on TRUE, but Shane (@duairc)
     -- wrote it to ensure that we don't need an Unpackspec a a.
-    let (r, right, tag') = flip IQ.runSimpleQueryArr arg $ proc () -> do
+    let true = HPQ.ConstExpr (HPQ.BoolLit True)
+    (r, right) <- flip IQ.runSimpleQueryArr' () $ proc () -> do
           a <- query -< ()
           true_ <- Rebind.rebind -< Opaleye.Field.toNullable (IC.Column true)
           returnA -< f true_ a
-        true = HPQ.ConstExpr (HPQ.BoolLit True)
-    in (r, true, right, tag')
+    pure (r, true, right)
 
 
 -- | An example to demonstrate how the functionality of (lateral)
diff --git a/src/Opaleye/Internal/Operators.hs b/src/Opaleye/Internal/Operators.hs
--- a/src/Opaleye/Internal/Operators.hs
+++ b/src/Opaleye/Internal/Operators.hs
@@ -28,7 +28,7 @@
 restrict = QA.QueryArr f where
   -- A where clause can always refer to columns defined by the query
   -- it references so needs no special treatment on LATERAL.
-  f (Column predicate, t0) = ((), \_ -> PQ.restrict predicate, t0)
+  f (Column predicate) = pure ((), PQ.aRestrict predicate)
 
 infix 4 .==
 (.==) :: forall columns. D.Default EqPP columns columns
@@ -103,11 +103,12 @@
                            -> (a -> HPQ.PrimExpr)
                            -> QA.QueryArr a columns
 relationValuedExprExplicit rem_ strings pe =
-  QA.productQueryArr $ \(a, tag) ->
+  QA.productQueryArr' $ \a -> do
+    tag <- Tag.fresh
     let (primExprs, projcols) = runRelExprMaker rem_ tag strings
         primQ :: PQ.PrimQuery
         primQ = PQ.RelExpr (pe a) projcols
-    in (primExprs, primQ, Tag.next tag)
+    pure (primExprs, primQ)
 
 relationValuedExpr :: D.Default RelExprMaker strings columns
                    => strings
diff --git a/src/Opaleye/Internal/Order.hs b/src/Opaleye/Internal/Order.hs
--- a/src/Opaleye/Internal/Order.hs
+++ b/src/Opaleye/Internal/Order.hs
@@ -53,27 +53,27 @@
 order :: HPQ.OrderOp -> (a -> F.Field_ n b) -> Order a
 order op f = Order (fmap (\column -> [(op, IC.unColumn column)]) f)
 
-orderByU :: Order a -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
-orderByU os (columns, primQ, t) = (columns, primQ', t)
+orderByU :: Order a -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
+orderByU os (columns, primQ) = (columns, primQ')
   where primQ' = PQ.DistinctOnOrderBy Nothing oExprs primQ
         oExprs = orderExprs columns os
 
 orderExprs :: a -> Order a -> [HPQ.OrderExpr]
 orderExprs x (Order os) = map (uncurry HPQ.OrderExpr) (os x)
 
-limit' :: Int -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
-limit' n (x, q, t) = (x, PQ.Limit (PQ.LimitOp n) q, t)
+limit' :: Int -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
+limit' n (x, q) = (x, PQ.Limit (PQ.LimitOp n) q)
 
-offset' :: Int -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
-offset' n (x, q, t) = (x, PQ.Limit (PQ.OffsetOp n) q, t)
+offset' :: Int -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
+offset' n (x, q) = (x, PQ.Limit (PQ.OffsetOp n) q)
 
 distinctOn :: U.Unpackspec b b -> (a -> b)
-           -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
+           -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
 distinctOn ups proj = distinctOnBy ups proj M.mempty
 
 distinctOnBy :: U.Unpackspec b b -> (a -> b) -> Order a
-             -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)
-distinctOnBy ups proj ord (cols, pq, t) = (cols, pqOut, t)
+             -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)
+distinctOnBy ups proj ord (cols, pq) = (cols, pqOut)
     where pqOut = case NL.nonEmpty (U.collectPEs ups (proj cols)) of
             Just xs -> PQ.DistinctOnOrderBy (Just xs) oexprs pq
             Nothing -> PQ.Limit (PQ.LimitOp 1) (PQ.DistinctOnOrderBy Nothing oexprs pq)
diff --git a/src/Opaleye/Internal/PrimQuery.hs b/src/Opaleye/Internal/PrimQuery.hs
--- a/src/Opaleye/Internal/PrimQuery.hs
+++ b/src/Opaleye/Internal/PrimQuery.hs
@@ -45,6 +45,69 @@
   mappend = (<>)
   mempty = NonLateral
 
+aLeftJoin :: HPQ.PrimExpr -> PrimQuery -> PrimQueryArr
+aLeftJoin cond primQuery' = PrimQueryArr $ \lat primQueryL ->
+  Join LeftJoin cond (NonLateral, primQueryL) (lat, primQuery')
+
+aProduct :: PrimQuery -> PrimQueryArr
+aProduct pq = PrimQueryArr (\lat primQuery -> times lat primQuery pq)
+
+aSemijoin :: SemijoinType -> PrimQuery -> PrimQueryArr
+aSemijoin joint existsQ = PrimQueryArr $ \_ primQ -> Semijoin joint primQ existsQ
+
+aRebind :: Bindings HPQ.PrimExpr -> PrimQueryArr
+aRebind bindings = PrimQueryArr $ \_ -> Rebind True bindings
+
+aRestrict :: HPQ.PrimExpr -> PrimQueryArr
+aRestrict predicate = PrimQueryArr $ \_ -> restrict predicate
+
+aLabel :: String -> PrimQueryArr
+aLabel l = PrimQueryArr $ \_ primQ -> Label l primQ
+
+-- The function 'Lateral -> PrimQuery -> PrimQuery' represents a
+-- select arrow in the following way:
+--
+--    Lateral
+-- -- ^ Whether to join me laterally
+-- -> PrimQuery
+-- -- ^ The query that I will be joined after.  If I refer to columns
+-- -- in here in a way that is only valid when I am joined laterally,
+-- -- then Lateral must be passed in as the argument above.
+-- -> PrimQuery
+-- -- ^ The result after joining me
+--
+-- It is *always* valid to pass Lateral as the first argument.  So why
+-- wouldn't we do that?  Because we don't want to generate lateral
+-- subqueries if they are not needed; it might have performance
+-- implications.  Even though there is good evidence that it *doesn't*
+-- have performance implications
+-- (https://github.com/tomjaguarpaw/haskell-opaleye/pull/480) we still
+-- want to be cautious.
+--
+-- Not every function of type `Lateral -> PrimQuery -> PrimQuery` is
+-- valid to be a PrimQuery.  I think the condition that they must
+-- satisfy for validity is
+--
+--     q == lateral (aProduct (toPrimQuery q)
+--
+-- where == is observable equivalence, i.e. both queries must give the
+-- same results when combined with other queries and then run.
+newtype PrimQueryArr =
+  PrimQueryArr { runPrimQueryArr :: Lateral -> PrimQuery -> PrimQuery }
+
+instance Semigroup PrimQueryArr where
+  PrimQueryArr f1 <> PrimQueryArr f2 = PrimQueryArr (\lat -> f2 lat . f1 lat)
+
+instance Monoid PrimQueryArr where
+  mappend = (<>)
+  mempty = PrimQueryArr (\_ -> id)
+
+lateral :: PrimQueryArr -> PrimQueryArr
+lateral (PrimQueryArr pq) = PrimQueryArr (\_ -> pq Lateral)
+
+toPrimQuery :: PrimQueryArr -> PrimQuery
+toPrimQuery (PrimQueryArr f) = f NonLateral Unit
+
 -- We use a 'NEL.NonEmpty' for Product because otherwise we'd have to check
 -- for emptiness explicity in the SQL generation phase.
 
diff --git a/src/Opaleye/Internal/QueryArr.hs b/src/Opaleye/Internal/QueryArr.hs
--- a/src/Opaleye/Internal/QueryArr.hs
+++ b/src/Opaleye/Internal/QueryArr.hs
@@ -19,65 +19,49 @@
 import qualified Control.Category as C
 import           Control.Category ((<<<), id)
 import           Control.Applicative (Applicative, pure, (<*>))
-import           Data.List.NonEmpty ( NonEmpty((:|)) )
+import           Control.Monad.Trans.State.Strict (State, runState, state)
 import qualified Data.Profunctor as P
 import qualified Data.Profunctor.Product as PP
-
--- Ideally this should be wrapped in a monad which automatically
--- increments the Tag, but I couldn't be bothered to do that.
---
--- The function 'Lateral -> PrimQuery -> PrimQuery' represents a
--- select arrow in the following way:
---
---    Lateral
--- -- ^ Whether to join me laterally
--- -> PrimQuery
--- -- ^ The query that I will be joined after.  If I refer to columns
--- -- in here in a way that is only valid when I am joined laterally,
--- -- then Lateral must be passed in as the argument above.
--- -> PrimQuery
--- -- ^ The result after joining me
---
--- It is *always* valid to pass Lateral as the first argument.  So why
--- wouldn't we do that?  Because we don't want to generate lateral
--- subqueries if they are not needed; it might have performance
--- implications.  Even though there is good evidence that it *doesn't*
--- have performance implications
--- (https://github.com/tomjaguarpaw/haskell-opaleye/pull/480) we still
--- want to be cautious.
+import           Data.Semigroup ((<>))
 
 -- | A parametrised 'Select'.  A @SelectArr a b@ accepts an argument
 -- of type @a@.
 --
 -- @SelectArr a b@ is analogous to a Haskell function @a -> [b]@.
-newtype SelectArr a b = QueryArr ((a, Tag) -> (b, PQ.Lateral -> PQ.PrimQuery -> PQ.PrimQuery, Tag))
+newtype SelectArr a b = QueryArr { unQueryArr :: a -> State Tag (b, PQ.PrimQueryArr) }
 
 type QueryArr = SelectArr
 type Query = SelectArr ()
 
-productQueryArr :: ((a, Tag) -> (b, PQ.PrimQuery, Tag)) -> QueryArr a b
-productQueryArr f = QueryArr g
-  where g (a0, t0) = (a1, \lat primQuery -> PQ.times lat primQuery primQuery', t1)
-          where (a1, primQuery', t1) = f (a0, t0)
+productQueryArr' :: (a -> State Tag (b, PQ.PrimQuery)) -> QueryArr a b
+productQueryArr' f = QueryArr $ \a -> do
+  (b, pq) <- f a
+  pure (b, PQ.aProduct pq)
 
-leftJoinQueryArr :: ((a, Tag) -> (b, HPQ.PrimExpr, PQ.PrimQuery, Tag)) -> QueryArr a b
-leftJoinQueryArr f = QueryArr g
-  where g (a0, t0) = (a1, \lat primQueryL ->
-                            PQ.Join PQ.LeftJoin cond (PQ.NonLateral, primQueryL) (lat, primQuery'), t1)
-          where (a1, cond, primQuery', t1) = f (a0, t0)
-mapPrimQuery :: (PQ.PrimQuery -> PQ.PrimQuery) -> SelectArr a b -> SelectArr a b
-mapPrimQuery f sa =
-  QueryArr ((\(b, pqf, t) -> (b, \lat -> f . pqf lat, t)) . runQueryArr sa)
+leftJoinQueryArr' :: (a -> State Tag (b, HPQ.PrimExpr, PQ.PrimQuery)) -> QueryArr a b
+leftJoinQueryArr' f = QueryArr $ \a -> do
+  (a1, cond, primQuery') <- f a
+  pure (a1, PQ.aLeftJoin cond primQuery')
 
-runQueryArr :: QueryArr a b -> (a, Tag) -> (b, PQ.Lateral -> PQ.PrimQuery -> PQ.PrimQuery, Tag)
-runQueryArr (QueryArr f) = f
+runSimpleQueryArr' :: QueryArr a b -> a -> State Tag (b, PQ.PrimQuery)
+runSimpleQueryArr' f a = do
+  (b, pqf) <- unQueryArr f a
+  pure (b, PQ.toPrimQuery pqf)
 
--- Unit defines no columns so joining it non-LATERAL is OK.
-runSimpleQueryArr :: QueryArr a b -> (a, Tag) -> (b, PQ.PrimQuery, Tag)
-runSimpleQueryArr f = (\(b, pqf, t) -> (b, pqf PQ.NonLateral PQ.Unit, t)) . runQueryArr f
+runStateQueryArr :: QueryArr a b -> a -> Tag -> (b, PQ.PrimQueryArr, Tag)
+runStateQueryArr (QueryArr f) a tag =
+  let ((b, pq), tag') = runState (f a) tag
+  in (b, pq, tag')
 
+stateQueryArr :: (a -> Tag -> (b, PQ.PrimQueryArr, Tag)) -> QueryArr a b
+stateQueryArr f = QueryArr $ \a -> state $ \tag ->
+  let (b, pq, tag') = f a tag
+  in ((b, pq), tag')
+
 runSimpleQueryArrStart :: QueryArr a b -> a -> (b, PQ.PrimQuery, Tag)
-runSimpleQueryArrStart q a = runSimpleQueryArr q (a, Tag.start)
+runSimpleQueryArrStart q a =
+  let ((b, pqa), t') = runState (runSimpleQueryArr' q a) Tag.start
+  in (b, pqa, t')
 
 runQueryArrUnpack :: U.Unpackspec a b
                   -> Query a -> ([HPQ.PrimExpr], PQ.PrimQuery, Tag)
@@ -85,9 +69,6 @@
   where (columns, primQ, endTag) = runSimpleQueryArrStart q ()
         primExprs = U.collectPEs unpackspec columns
 
-first3 :: (a1 -> b) -> (a1, a2, a3) -> (b, a2, a3)
-first3 f (a1, a2, a3) = (f a1, a2, a3)
-
 -- | A @SELECT@, i.e. an SQL query which produces a collection of
 -- rows.
 --
@@ -103,12 +84,9 @@
 -- 'Opaleye.Binary.union', 'Opaleye.Binary.intersect' and
 -- 'Opaleye.Binary.except' to two 'SelectArr's).
 lateral :: (i -> Select a) -> SelectArr i a
-lateral f = QueryArr qa
-  where
-    qa (i, tag) = (a, primQueryJoin, tag')
-      where
-        (a, primQueryR, tag') = runQueryArr (f i) ((), tag)
-        primQueryJoin _ = primQueryR PQ.Lateral
+lateral f = QueryArr $ \i -> do
+  (a, primQueryR) <- unQueryArr (f i) ()
+  pure (a, PQ.lateral primQueryR)
 
 -- | Convert an arrow argument into a function argument so that it can
 -- be applied inside @do@-notation rather than arrow notation.
@@ -126,21 +104,25 @@
 
 instance C.Category QueryArr where
   id = arr id
-  QueryArr f . QueryArr g = QueryArr (\(a, t) ->
-                                        let (b, pqf, t') = g (a, t)
-                                            (c, pqf', t'') = f (b, t')
-                                        in (c, \lat -> pqf' lat . pqf lat, t''))
+  QueryArr f . QueryArr g = QueryArr $ \a -> do
+    (b, pqf)  <- g a
+    (c, pqf') <- f b
+    pure (c, pqf <> pqf')
 
 instance Arr.Arrow QueryArr where
-  arr f   = QueryArr (\(a, t) -> (f a, const id, t))
+  arr f   = QueryArr (\a -> pure (f a, mempty))
   first (QueryArr f) = QueryArr g
-    where g ((b, d), t0) = first3 (\c -> (c, d)) (f (b, t0))
+    where g (b, d) = do
+            (c, pq) <- f b
+            pure ((c, d), pq)
 
 instance Arr.ArrowChoice QueryArr where
   left (QueryArr f) = QueryArr g
-    where g (e, t0) = case e of
-            Left a -> first3 Left (f (a, t0))
-            Right b -> (Right b, const id, t0)
+    where g e = case e of
+            Left a -> do
+              (r, pq) <- f a
+              pure (Left r, pq)
+            Right b -> pure (Right b, mempty)
 
 instance Arr.ArrowApply QueryArr where
   app = arrowApply
diff --git a/src/Opaleye/Internal/Rebind.hs b/src/Opaleye/Internal/Rebind.hs
--- a/src/Opaleye/Internal/Rebind.hs
+++ b/src/Opaleye/Internal/Rebind.hs
@@ -13,6 +13,10 @@
 rebind = rebindExplicit def
 
 rebindExplicit :: Unpackspec a b -> SelectArr a b
-rebindExplicit u = QueryArr (\(a, tag) ->
-                     let (b, bindings) = PM.run (runUnpackspec u (PM.extractAttr "rebind" tag) a)
-                     in (b, \_ -> PQ.Rebind True bindings, Tag.next tag))
+rebindExplicit = rebindExplicitPrefix "rebind"
+
+rebindExplicitPrefix :: String -> Unpackspec a b -> SelectArr a b
+rebindExplicitPrefix prefix u = QueryArr $ \a -> do
+  tag <- Tag.fresh
+  let (b, bindings) = PM.run (runUnpackspec u (PM.extractAttr prefix tag) a)
+  pure (b, PQ.aRebind bindings)
diff --git a/src/Opaleye/Internal/RunQuery.hs b/src/Opaleye/Internal/RunQuery.hs
--- a/src/Opaleye/Internal/RunQuery.hs
+++ b/src/Opaleye/Internal/RunQuery.hs
@@ -22,7 +22,6 @@
                                           Nullability(Nullable, NonNullable))
 import qualified Opaleye.Internal.PackMap as PackMap
 import qualified Opaleye.Internal.QueryArr as Q
-import qualified Opaleye.Column as C
 import qualified Opaleye.Internal.Unpackspec as U
 import qualified Opaleye.Internal.PGTypesExternal as T
 import qualified Opaleye.Internal.PGTypes as IPT (strictDecodeUtf8)
diff --git a/src/Opaleye/Internal/RunQueryExternal.hs b/src/Opaleye/Internal/RunQueryExternal.hs
--- a/src/Opaleye/Internal/RunQueryExternal.hs
+++ b/src/Opaleye/Internal/RunQueryExternal.hs
@@ -16,12 +16,10 @@
 import qualified Database.PostgreSQL.Simple as PGS
 import qualified Database.PostgreSQL.Simple.Cursor  as PGSC
 
-import           Opaleye.Column (Column)
 import qualified Opaleye.Select as S
 import           Opaleye.Internal.RunQuery (prepareQuery)
 import qualified Opaleye.Internal.RunQuery as IRQ
 
-import qualified Data.Profunctor as P
 import qualified Data.Profunctor.Product.Default as D
 
 -- * Running 'S.Select's
diff --git a/src/Opaleye/Internal/Tag.hs b/src/Opaleye/Internal/Tag.hs
--- a/src/Opaleye/Internal/Tag.hs
+++ b/src/Opaleye/Internal/Tag.hs
@@ -1,5 +1,7 @@
 module Opaleye.Internal.Tag where
 
+import Control.Monad.Trans.State.Strict ( get, modify', State )
+
 -- | Tag is for use as a source of unique IDs in QueryArr
 newtype Tag = UnsafeTag Int deriving (Read, Show)
 
@@ -14,3 +16,9 @@
 
 tagWith :: Tag -> String -> String
 tagWith t s = s ++ "_" ++ show (unsafeUnTag t)
+
+fresh :: State Tag Tag
+fresh = do
+  t <- get
+  modify' next
+  pure t
diff --git a/src/Opaleye/Internal/Values.hs b/src/Opaleye/Internal/Values.hs
--- a/src/Opaleye/Internal/Values.hs
+++ b/src/Opaleye/Internal/Values.hs
@@ -26,8 +26,8 @@
 valuesU :: U.Unpackspec columns columns'
         -> ValuesspecUnsafe columns columns'
         -> [columns]
-        -> ((), T.Tag) -> (columns', PQ.PrimQuery, T.Tag)
-valuesU unpack valuesspec rows ((), t) = (newColumns, primQ', T.next t)
+        -> ((), T.Tag) -> (columns', PQ.PrimQuery)
+valuesU unpack valuesspec rows ((), t) = (newColumns, primQ')
   where runRow row = valuesRow
            where (_, valuesRow) =
                    PM.run (U.runUnpackspec unpack extractValuesEntry row)
@@ -68,9 +68,9 @@
 
 valuesUSafe :: Valuesspec columns columns'
             -> [columns]
-            -> ((), T.Tag) -> (columns', PQ.PrimQuery, T.Tag)
+            -> ((), T.Tag) -> (columns', PQ.PrimQuery)
 valuesUSafe valuesspec@(ValuesspecSafe _ unpack) rows ((), t) =
-  (newColumns, primQ', T.next t)
+  (newColumns, primQ')
   where runRow row =
           case PM.run (U.runUnpackspec unpack extractValuesEntry row) of
             (_, []) -> [zero]
diff --git a/src/Opaleye/Label.hs b/src/Opaleye/Label.hs
--- a/src/Opaleye/Label.hs
+++ b/src/Opaleye/Label.hs
@@ -1,4 +1,8 @@
+{-# LANGUAGE Arrows #-}
+
 module Opaleye.Label (
+  label',
+  -- * Deprecated
   label
   ) where
 
@@ -6,6 +10,16 @@
 import qualified Opaleye.Internal.QueryArr as Q
 import qualified Opaleye.Select            as S
 
+import           Control.Arrow (returnA)
+
 -- | Add a commented label to the generated SQL.
+label' :: String -> S.Select ()
+label' l = Q.QueryArr f where
+  f () = pure ((), PQ.aLabel l)
+
+-- | Will be deprecated in version 0.10.  Use 'label\'' instead.
 label :: String -> S.SelectArr a b -> S.SelectArr a b
-label = Q.mapPrimQuery . PQ.Label
+label l s = proc a -> do
+  b <- s -< a
+  label' l -< ()
+  returnA -< b
diff --git a/src/Opaleye/Operators.hs b/src/Opaleye/Operators.hs
--- a/src/Opaleye/Operators.hs
+++ b/src/Opaleye/Operators.hs
@@ -123,7 +123,7 @@
 import qualified Opaleye.Internal.Column as C
 import qualified Opaleye.Internal.JSONBuildObjectFields as JBOF
 import           Opaleye.Internal.QueryArr (SelectArr(QueryArr),
-                                            runSimpleQueryArr)
+                                            runSimpleQueryArr')
 import qualified Opaleye.Internal.PrimQuery as PQ
 import qualified Opaleye.Internal.Operators as O
 import           Opaleye.Internal.Helpers   ((.:))
@@ -161,16 +161,18 @@
 restrictExists criteria = QueryArr f where
   -- A where exists clause can always refer to columns defined by the
   -- query it references so needs no special treatment on LATERAL.
-  f (a, t0) = ((), \_ primQ -> PQ.Semijoin PQ.Semi primQ existsQ, t1) where
-    (_, existsQ, t1) = runSimpleQueryArr criteria (a, t0)
+  f a = do
+    (_, existsQ) <- runSimpleQueryArr' criteria a
+    pure ((), PQ.aSemijoin PQ.Semi existsQ)
 
 {-| Add a @WHERE NOT EXISTS@ clause to the current query. -}
 restrictNotExists :: S.SelectArr a b -> S.SelectArr a ()
 restrictNotExists criteria = QueryArr f where
   -- A where exists clause can always refer to columns defined by the
   -- query it references so needs no special treatment on LATERAL.
-  f (a, t0) = ((), \_ primQ -> PQ.Semijoin PQ.Anti primQ existsQ, t1) where
-    (_, existsQ, t1) = runSimpleQueryArr criteria (a, t0)
+  f a = do
+    (_, existsQ) <- runSimpleQueryArr' criteria a
+    pure ((), PQ.aSemijoin PQ.Anti existsQ)
 
 infix 4 .==
 (.==) :: Field a -> Field a -> F.Field T.SqlBool
diff --git a/src/Opaleye/Order.hs b/src/Opaleye/Order.hs
--- a/src/Opaleye/Order.hs
+++ b/src/Opaleye/Order.hs
@@ -22,6 +22,9 @@
                      , O.exact
                      -- * Other
                      , SqlOrd
+                     -- * Explicit versions
+                     , distinctOnExplicit
+                     , distinctOnByExplicit
                      -- * Deprecated
                      , distinctOnCorrect
                      , distinctOnByCorrect
@@ -54,7 +57,9 @@
 -}
 orderBy :: O.Order a -> S.Select a -> S.Select a
 orderBy os q =
-  Q.productQueryArr (O.orderByU os . Q.runSimpleQueryArr q)
+  Q.productQueryArr' $ \() -> do
+    a_pq <- Q.runSimpleQueryArr' q ()
+    pure (O.orderByU os a_pq)
 
 -- | Specify an ascending ordering by the given expression.
 --   (Any NULLs appear last)
@@ -111,7 +116,9 @@
 @
 -}
 limit :: Int -> S.Select a -> S.Select a
-limit n a = Q.productQueryArr (O.limit' n . Q.runSimpleQueryArr a)
+limit n a = Q.productQueryArr' $ \() -> do
+  a_pq <- Q.runSimpleQueryArr' a ()
+  pure (O.limit' n a_pq)
 
 {- |
 Offset the results of the given 'S.Select' by the given amount, skipping
@@ -121,7 +128,9 @@
 'offset' with 'limit'.
 -}
 offset :: Int -> S.Select a -> S.Select a
-offset n a = Q.productQueryArr (O.offset' n . Q.runSimpleQueryArr a)
+offset n a = Q.productQueryArr' $ \() -> do
+  a_pq <- Q.runSimpleQueryArr' a ()
+  pure (O.offset' n a_pq)
 
 -- * Distinct on
 
@@ -130,7 +139,7 @@
                   => (a -> b)
                   -> S.Select a
                   -> S.Select a
-distinctOnCorrect proj q = Q.productQueryArr (O.distinctOn D.def proj . Q.runSimpleQueryArr q)
+distinctOnCorrect = distinctOnExplicit D.def
 
 -- | Use 'distinctOnBy' instead.  Will be deprecated in 0.10.
 distinctOnByCorrect :: D.Default U.Unpackspec b b
@@ -138,7 +147,7 @@
                     -> O.Order a
                     -> S.Select a
                     -> S.Select a
-distinctOnByCorrect proj ord q = Q.productQueryArr (O.distinctOnBy D.def proj ord . Q.runSimpleQueryArr q)
+distinctOnByCorrect = distinctOnByExplicit D.def
 
 
 -- * Other
@@ -176,3 +185,20 @@
 distinctOnBy :: D.Default U.Unpackspec b b => (a -> b) -> O.Order a
              -> S.Select a -> S.Select a
 distinctOnBy = distinctOnByCorrect
+
+distinctOnExplicit :: U.Unpackspec b b
+                   -> (a -> b)
+                   -> S.Select a
+                   -> S.Select a
+distinctOnExplicit unpack proj q = Q.productQueryArr' $ \() -> do
+  a_pq <- Q.runSimpleQueryArr' q ()
+  pure (O.distinctOn unpack proj a_pq)
+
+distinctOnByExplicit :: U.Unpackspec b b
+                     -> (a -> b)
+                     -> O.Order a
+                     -> S.Select a
+                     -> S.Select a
+distinctOnByExplicit unpack proj ord q = Q.productQueryArr' $ \() -> do
+  a_pq <- Q.runSimpleQueryArr' q ()
+  pure (O.distinctOnBy unpack proj ord a_pq)
diff --git a/src/Opaleye/RunSelect.hs b/src/Opaleye/RunSelect.hs
--- a/src/Opaleye/RunSelect.hs
+++ b/src/Opaleye/RunSelect.hs
@@ -29,10 +29,8 @@
    runSelectTF,
    ) where
 
-import qualified Data.Profunctor            as P
 import qualified Database.PostgreSQL.Simple as PGS
 
-import qualified Opaleye.Column as C
 import qualified Opaleye.Select as S
 import qualified Opaleye.Internal.RunQueryExternal as RQ
 import qualified Opaleye.TypeFamilies as TF
diff --git a/src/Opaleye/SqlTypes.hs b/src/Opaleye/SqlTypes.hs
--- a/src/Opaleye/SqlTypes.hs
+++ b/src/Opaleye/SqlTypes.hs
@@ -19,6 +19,7 @@
   -- ** Type classes
   IC.SqlNum,
   IC.SqlIntegral,
+  IC.SqlFractional,
   -- * Date and time
   -- ** Creating values
   sqlDay,
diff --git a/src/Opaleye/Table.hs b/src/Opaleye/Table.hs
--- a/src/Opaleye/Table.hs
+++ b/src/Opaleye/Table.hs
@@ -132,6 +132,7 @@
                     -> Table a tablefields
                     -- ^
                     -> S.Select fields
-selectTableExplicit cm table' = Q.productQueryArr f where
-  f ((), t0) = (retwires, primQ, Tag.next t0) where
-    (retwires, primQ) = T.queryTable cm table' t0
+selectTableExplicit cm table' = Q.productQueryArr' $ \() -> do
+  t0 <- Tag.fresh
+  let (retwires, primQ) = T.queryTable cm table' t0
+  pure (retwires, primQ)
diff --git a/src/Opaleye/Values.hs b/src/Opaleye/Values.hs
--- a/src/Opaleye/Values.hs
+++ b/src/Opaleye/Values.hs
@@ -16,6 +16,7 @@
   ) where
 
 import qualified Opaleye.Internal.QueryArr as Q
+import qualified Opaleye.Internal.Tag as Tag
 import           Opaleye.Internal.Values as V
 import qualified Opaleye.Internal.Unpackspec as U
 import qualified Opaleye.Select              as S
@@ -33,7 +34,9 @@
                      -> V.ValuesspecUnsafe fields fields'
                      -> [fields] -> S.Select fields'
 valuesUnsafeExplicit unpack valuesspec fields =
-  Q.productQueryArr (V.valuesU unpack valuesspec fields)
+  Q.productQueryArr' $ \() -> do
+  t <- Tag.fresh
+  pure (V.valuesU unpack valuesspec fields ((), t))
 
 -- | 'values' implements Postgres's @VALUES@ construct and allows you
 -- to create a @SELECT@ that consists of the given rows.
@@ -57,7 +60,9 @@
 valuesExplicit :: V.Valuesspec fields fields'
                -> [fields] -> S.Select fields'
 valuesExplicit valuesspec fields =
-  Q.productQueryArr (V.valuesUSafe valuesspec fields)
+  Q.productQueryArr' $ \() -> do
+    t <- Tag.fresh
+    pure (V.valuesUSafe valuesspec fields ((), t))
 
 {-# DEPRECATED valuesSafe "Use 'values' instead.  Will be removed in 0.10." #-}
 valuesSafe :: Default V.Valuesspec fields fields