Add withRecursiveDistinct which uses UNION instead of UNION ALL

I should have added this originally, but I omitted it at the time because I erroneously thought that because `union a b` is the same as `distinct $ unionAll a b`, therefore `distinct $ withRecursive s f` could always be used instead of `withRecursiveDistinct`, rendering the latter redundant.

I've added some comments explaining operationally what is happening in each of these calls that should hopefully explain why these are not the same.

In short, using `UNION` instead of `UNION ALL` means that at each recursive step, you can consider only the rows that don't already exist in the result set as opposed to all the rows returned by that step. This is useful because there are queries that terminate quickly when written with `withRecursiveDistinct` but which run forever (because the same rows are being fed back in over and over again) when written with `withRecursive`, even if you try to wrap it in a `distinct`.

src/Opaleye/With.hs

@@ -3,16 +3,18 @@
 module Opaleye.With
   ( with,
     withRecursive,
+    withRecursiveDistinct,
 
     -- * Explicit versions
     withExplicit,
     withRecursiveExplicit,
+    withRecursiveDistinctExplicit,
   )
 where
 
 import Control.Monad.Trans.State.Strict (State)
 import Data.Profunctor.Product.Default (Default, def)
-import Opaleye.Binary (unionAllExplicit)
+import Opaleye.Binary (unionAllExplicit, unionExplicit)
 import Opaleye.Internal.Binary (Binaryspec (..))
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
 import Opaleye.Internal.PackMap (PackMap (..))
@@ -26,14 +28,39 @@ import Opaleye.Internal.Unpackspec (Unpackspec (..), runUnpackspec)
 with :: Default Unpackspec a a => Select a -> (Select a -> Select b) -> Select b
 with = withExplicit def
 
--- | @withRecursive s f@ is the smallest set of rows @r@ such that
+-- | Denotionally, @withRecursive s f@ is the smallest set of rows @r@ such
+-- that
 --
 -- @
 -- r == s \`'unionAll'\` (r >>= f)
 -- @
+--
+-- Operationally, @withRecursive s f@ takes each row in an initial set @s@ and
+-- supplies it to @f@, resulting in a new generation of rows which are added
+-- to the result set. Each row from this new generation is then fed back to
+-- @f@, and this process is repeated until a generation comes along for which
+-- @f@ returns an empty set for each row therein.
 withRecursive :: Default Binaryspec a a => Select a -> (a -> Select a) -> Select a
 withRecursive = withRecursiveExplicit def
 
+-- | Denotationally, @withRecursiveDistinct s f@ is the smallest set of rows
+-- @r@ such that
+--
+-- @
+-- r == s \`'union'\` (r >>= f)
+-- @
+--
+-- Operationally, @withRecursiveDistinct s f@ takes each /distinct/ row in an
+-- initial set @s@ and supplies it to @f@, resulting in a new generation of
+-- rows. Any rows returned by @f@ that already exist in the result set are not
+-- considered part of this new generation by `withRecursiveDistinct` (in
+-- contrast to `withRecursive`). This new generation is then added to the
+-- result set, and each row therein is then fed back to @f@, and this process
+-- is repeated until a generation comes along for which @f@ returns no rows
+-- that don't already exist in the result set.
+withRecursiveDistinct :: Default Binaryspec a a => Select a -> (a -> Select a) -> Select a
+withRecursiveDistinct = withRecursiveDistinctExplicit def
+
 withExplicit :: Unpackspec a a -> Select a -> (Select a -> Select b) -> Select b
 withExplicit unpackspec rhsSelect bodySelect = productQueryArr $ do
   withG unpackspec PQ.NonRecursive (\_ -> rhsSelect) bodySelect
@@ -47,6 +74,15 @@ withRecursiveExplicit binaryspec base recursive = productQueryArr $ do
   where
     unpackspec = binaryspecToUnpackspec binaryspec
 
+withRecursiveDistinctExplicit :: Binaryspec a a -> Select a -> (a -> Select a) -> Select a
+withRecursiveDistinctExplicit binaryspec base recursive = productQueryArr $ do
+  let bodySelect selectCte = selectCte
+  let rhsSelect selectCte = unionExplicit binaryspec base (selectCte >>= recursive)
+
+  withG unpackspec PQ.Recursive rhsSelect bodySelect
+  where
+    unpackspec = binaryspecToUnpackspec binaryspec
+
 withG ::
   Unpackspec a a ->
   PQ.Recursive ->