opaleye 0.10.0.0 → 0.10.1.0

raw patch · 3 files changed

+45/−5 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• opaleye.cabal +3/−3
• src/Opaleye/With.hs +38/−2

@@ -1,3 +1,7 @@+## 0.10.1.0++* Added `withRecursiveDistinct` (thanks to Shane O'Brien)+ ## 0.10.0.0  * Changed `relationValuedExpr` to work in more cases.  (This is a

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2023 Tom Ellis-version:         0.10.0.0+version:         0.10.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@@ -26,13 +26,13 @@   default-language: Haskell2010   hs-source-dirs: src   build-depends:-      aeson               >= 0.6     && < 2.2+      aeson               >= 0.6     && < 2.3     , base                >= 4.9     && < 4.19     , base16-bytestring   >= 0.1.1.6 && < 1.1     , case-insensitive    >= 1.2     && < 1.3     , bytestring          >= 0.10    && < 0.12     , contravariant       >= 1.2     && < 1.6-    , postgresql-simple   >= 0.6     && < 0.7+    , postgresql-simple   >= 0.6     && < 0.8     , pretty              >= 1.1.1.0 && < 1.2     , product-profunctors >= 0.11.0.3 && < 0.12     , profunctors         >= 4.0     && < 5.7

@@ -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 @@ 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@@ -42,6 +69,15 @@ withRecursiveExplicit binaryspec base recursive = productQueryArr $ do   let bodySelect selectCte = selectCte   let rhsSelect selectCte = unionAllExplicit binaryspec base (selectCte >>= recursive)++  withG unpackspec PQ.Recursive rhsSelect bodySelect+  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