opaleye 0.10.1.0 → 0.10.1.1

raw patch · 7 files changed

+46/−5 lines, 7 filesdep ~basedep ~textPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: base, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• Test/Test.hs +15/−0
• opaleye.cabal +1/−1
• src/Opaleye/Internal/PrimQuery.hs +3/−0
• src/Opaleye/Internal/Rebind.hs +7/−0
• src/Opaleye/Internal/Sql.hs +9/−3
• src/Opaleye/With.hs +5/−1

@@ -1,3 +1,9 @@+## 0.10.1.1++* Fix bugs in `WITH`.  See+  https://github.com/tomjaguarpaw/haskell-opaleye/pull/572 (thanks to+  Shane O'Brien)+ ## 0.10.1.0  * Added `withRecursiveDistinct` (thanks to Shane O'Brien)

@@ -25,6 +25,7 @@ import qualified Data.Text                        as T import qualified Data.Time.Compat                 as Time import qualified Data.Time.Clock.POSIX.Compat     as Time+import           Data.Tuple (swap) import qualified Database.PostgreSQL.Simple       as PGS import qualified Database.PostgreSQL.Simple.Range as R import           GHC.Int                          (Int64)@@ -832,6 +833,18 @@   where with = O.with table1Q $ \t -> (,) <$> t <*> table2Q         expected = (,) <$> table1data <*> table2data +testNestedWith :: Test+testNestedWith = it "with nested within with" $ testH with (`shouldBe` expected)+  where+    with = O.with table1Q $ \t -> O.with table2Q $ \u -> (,) <$> t <*> u+    expected = (,) <$> table1data <*> table2data++testWithRebind :: Test+testWithRebind = it "with (rebinding)" $ testH with (`shouldBe` expected)+  where+    with = O.with (fmap swap table1Q) $ \t -> (,) <$> t <*> table2Q+    expected = (,) <$> fmap swap table1data <*> table2data+ -- TODO: This is getting too complicated testUpdate :: Test testUpdate = it "" $ \conn -> do@@ -1597,5 +1610,7 @@       describe "with" $ do         testWithRecursive         testWith+        testNestedWith+        testWithRebind       describe "relation valued exprs" $ do         testUnnest

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2023 Tom Ellis-version:         0.10.1.0+version:         0.10.1.1 synopsis:        An SQL-generating DSL targeting PostgreSQL description:     An SQL-generating DSL targeting PostgreSQL.  Allows                  Postgres queries to be written within Haskell in a

@@ -63,6 +63,9 @@ aRebind :: Bindings HPQ.PrimExpr -> PrimQueryArr aRebind bindings = PrimQueryArr $ \_ -> Rebind True bindings +aRebindNoStar :: Bindings HPQ.PrimExpr -> PrimQueryArr+aRebindNoStar bindings = PrimQueryArr $ \_ -> Rebind False bindings+ aRestrict :: HPQ.PrimExpr -> PrimQueryArr aRestrict predicate = PrimQueryArr $ \_ -> restrict predicate 

@@ -21,3 +21,10 @@   pure $ \a ->     let (b, bindings) = PM.run (runUnpackspec u (PM.extractAttr prefix tag) a)     in (b, PQ.aRebind bindings)++rebindExplicitPrefixNoStar :: String -> Unpackspec a b -> SelectArr a b+rebindExplicitPrefixNoStar prefix u = selectArr $ do+  tag <- Tag.fresh+  pure $ \a ->+    let (b, bindings) = PM.run (runUnpackspec u (PM.extractAttr prefix tag) a)+    in (b, PQ.aRebindNoStar bindings)

@@ -3,7 +3,7 @@  module Opaleye.Internal.Sql where -import           Prelude hiding (product)+import           Prelude hiding (filter, product)  import qualified Opaleye.Internal.PrimQuery as PQ @@ -264,14 +264,20 @@   bSelect2 = select2   } -with :: PQ.Recursive -> Symbol -> [Symbol]-> Select -> Select -> Select-with recursive name cols wWith wSelect = SelectWith $ With {..}+with :: PQ.Recursive -> Symbol -> [Symbol] -> Select -> Select -> Select+with recursive name cols wWith wSelect =+  SelectFrom+    newSelect+      { attrs = Star+      , tables = [(NonLateral, SelectWith $ With {..}, Nothing)]+      }   where    wTable = HSql.SqlTable Nothing (sqlSymbol name)    wRecursive = case recursive of      PQ.NonRecursive -> NonRecursive      PQ.Recursive -> Recursive    wCols = map (HSql.SqlColumn . sqlSymbol) cols+  joinType :: PQ.JoinType -> JoinType joinType PQ.LeftJoin = LeftJoin

@@ -12,6 +12,7 @@   ) where +import Control.Category ((>>>)) import Control.Monad.Trans.State.Strict (State) import Data.Profunctor.Product.Default (Default, def) import Opaleye.Binary (unionAllExplicit, unionExplicit)@@ -21,6 +22,7 @@ import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.PrimQuery as PQ import Opaleye.Internal.QueryArr (Select, productQueryArr, runSimpleSelect)+import Opaleye.Internal.Rebind (rebindExplicitPrefixNoStar) import qualified Opaleye.Internal.Sql as Sql import qualified Opaleye.Internal.Tag as Tag import Opaleye.Internal.Unpackspec (Unpackspec (..), runUnpackspec)@@ -63,7 +65,9 @@  withExplicit :: Unpackspec a a -> Select a -> (Select a -> Select b) -> Select b withExplicit unpackspec rhsSelect bodySelect = productQueryArr $ do-  withG unpackspec PQ.NonRecursive (\_ -> rhsSelect) bodySelect+  withG unpackspec PQ.NonRecursive (\_ -> rebind rhsSelect) bodySelect+  where+    rebind = (>>> rebindExplicitPrefixNoStar "rebind" unpackspec)  withRecursiveExplicit :: Binaryspec a a -> Select a -> (a -> Select a) -> Select a withRecursiveExplicit binaryspec base recursive = productQueryArr $ do