Add loopDistinct

changelog.d/20230707_191301_ollie_scriv.md

@@ -1,3 +1,3 @@
 ### Added
 
-- - `Rel8.loop`, which allows writing `WITH .. RECURSIVE` queries. ([#180](https://github.com/circuithub/rel8/pull/180))
+- - `Rel8.loop` and `Rel8.loopDistinct`, which allow writing `WITH .. RECURSIVE` queries. ([#180](https://github.com/circuithub/rel8/pull/180))

rel8.cabal

@@ -33,7 +33,7 @@ library
     , data-textual
     , hasql ^>= 1.6.1.2
     , network-ip
-    , opaleye ^>= 0.10.0.0
+    , opaleye ^>= 0.10.1.0
     , pretty
     , profunctors
     , product-profunctors

src/Rel8.hs

@@ -261,6 +261,7 @@ module Rel8
 
     -- ** @WITH RECURSIVE@
   , loop
+  , loopDistinct
 
     -- ** Aggregation
   , Aggregator

src/Rel8/Query/Loop.hs

@@ -2,13 +2,14 @@
 
 module Rel8.Query.Loop
   ( loop
+  , loopDistinct
   ) where
 
 -- base
 import Prelude
 
 -- opaleye
-import Opaleye.With ( withRecursiveExplicit )
+import Opaleye.With (withRecursiveExplicit, withRecursiveDistinctExplicit)
 
 -- rel8
 import Rel8.Expr ( Expr )
@@ -23,10 +24,50 @@ import Rel8.Table.Opaleye ( binaryspec )
 -- under the hood. The first argument to 'loop' is what the Postgres
 -- documentation refers to as the \"non-recursive term\" and the second
 -- argument is the \"recursive term\", which is defined in terms of the result
--- of the \"non-recursive term\".
+-- of the \"non-recursive term\". 'loop' uses @UNION ALL@ to combine the
+-- recursive and non-recursive terms.
+--
+-- Denotionally, @'loop' s f@ is the smallest set of rows @r@ such
+-- that
+--
+-- @
+-- r == s \`'Rel8.unionAll'\` (r >>= f)
+-- @
+--
+-- Operationally, @'loop' 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.
 loop :: Table Expr a => Query a -> (a -> Query a) -> Query a
 loop base recurse =
   fromOpaleye $ withRecursiveExplicit binaryspec base' recurse'
   where
     base' = toOpaleye base
     recurse' = toOpaleye . recurse
+
+
+-- | 'loopDistinct' is like 'loop' but uses @UNION@ instead of @UNION ALL@ to
+-- combine the recursive and non-recursive terms.
+--
+-- Denotationally, @'loopDistinct' s f@ is the smallest set of rows
+-- @r@ such that
+--
+-- @
+-- r == s \`'Rel8.union'\` (r >>= f)
+-- @
+--
+-- Operationally, @'loopDistinct' 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 'loopDistinct' (in contrast to
+-- 'loop'). 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.
+loopDistinct :: Table Expr a => Query a -> (a -> Query a) -> Query a
+loopDistinct base recurse =
+  fromOpaleye $ withRecursiveDistinctExplicit binaryspec base' recurse'
+  where
+    base' = toOpaleye base
+    recurse' = toOpaleye . recurse