opaleye 0.9.3.0 → 0.9.3.1

raw patch · 14 files changed

+72/−46 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• opaleye.cabal +1/−1
• src/Opaleye/Aggregate.hs +1/−1
• src/Opaleye/Exists.hs +2/−2
• src/Opaleye/Internal/Binary.hs +2/−2
• src/Opaleye/Internal/Join.hs +8/−7
• src/Opaleye/Internal/Locking.hs +1/−1
• src/Opaleye/Internal/MaybeFields.hs +3/−3
• src/Opaleye/Internal/Operators.hs +8/−7
• src/Opaleye/Internal/QueryArr.hs +27/−8
• src/Opaleye/Internal/Rebind.hs +5/−4
• src/Opaleye/Label.hs +2/−2
• src/Opaleye/Order.hs +5/−5
• src/Opaleye/With.hs +3/−3

@@ -1,3 +1,7 @@+## 0.9.3.1++* No externally visible changes+ ## 0.9.3.0  * Add `with` and `withRecursive` (thanks to Erik Hesselink and Shane

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2022 Tom Ellis-version:         0.9.3.0+version:         0.9.3.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

@@ -83,7 +83,7 @@ -- 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 $ do-  (a, pq) <- Q.runSimpleQueryArr' q ()+  (a, pq) <- Q.runSimpleSelect q   t <- Tag.fresh   pure (A.aggregateU agg (a, pq, t)) 

@@ -2,7 +2,7 @@  import           Opaleye.Field (Field) import           Opaleye.Internal.Column (Field_(Column))-import           Opaleye.Internal.QueryArr (productQueryArr, runSimpleQueryArr')+import           Opaleye.Internal.QueryArr (productQueryArr, runSimpleSelect) import           Opaleye.Internal.PackMap (run, extractAttr) import           Opaleye.Internal.PrimQuery (PrimQuery' (Exists)) import           Opaleye.Internal.Tag (fresh)@@ -14,7 +14,7 @@ -- This operation is equivalent to Postgres's @EXISTS@ operator. exists :: Select a -> Select (Field SqlBool) exists q = productQueryArr $ do-  (_, query) <- runSimpleQueryArr' q ()+  (_, query) <- runSimpleSelect q   tag <- fresh   let (result, [(binding, ())]) = run (extractAttr "exists" tag ())   pure (Column result, Exists binding query)

@@ -41,8 +41,8 @@ sameTypeBinOpHelper :: PQ.BinOp -> Binaryspec columns columns'                     -> Q.Query columns -> Q.Query columns -> Q.Query columns' sameTypeBinOpHelper binop binaryspec q1 q2 = Q.productQueryArr $ do-  (columns1, primQuery1) <- Q.runSimpleQueryArr' q1 ()-  (columns2, primQuery2) <- Q.runSimpleQueryArr' q2 ()+  (columns1, primQuery1) <- Q.runSimpleSelect q1+  (columns2, primQuery2) <- Q.runSimpleSelect q2    endTag <- T.fresh 

@@ -49,8 +49,8 @@              -> Q.Query (returnedColumnsA, returnedColumnsB) joinExplicit uA uB returnColumnsA returnColumnsB joinType              qA qB cond = Q.productQueryArr $ do-  (columnsA, primQueryA) <- Q.runSimpleQueryArr' qA ()-  (columnsB, primQueryB) <- Q.runSimpleQueryArr' qB ()+  (columnsA, primQueryA) <- Q.runSimpleSelect qA+  (columnsB, primQueryB) <- Q.runSimpleSelect qB    endTag <- T.fresh @@ -75,13 +75,14 @@                   -> Q.Query a                   -> Q.QueryArr (a -> Field T.PGBool) nullableA leftJoinAExplicit uA nullmaker rq =-  Q.leftJoinQueryArr' $ \p -> do-    (newColumnsR, right) <- flip Q.runSimpleQueryArr' () $ proc () -> do+  Q.leftJoinQueryArr' $ do+    (newColumnsR, right) <- Q.runSimpleSelect $ proc () -> do           a <- rq -< ()           Rebind.rebindExplicit uA -< a-    let renamedNullable = toNullable nullmaker newColumnsR-        Column cond = p newColumnsR-    pure (renamedNullable, cond, right)+    pure $ \p ->+      let renamedNullable = toNullable nullmaker newColumnsR+          Column cond = p newColumnsR+      in (renamedNullable, cond, right)  optionalRestrict :: D.Default U.Unpackspec a a                  => S.Select a

@@ -22,5 +22,5 @@ -- easy to create queries that fail at run time using this operation. forUpdate :: Q.Select a -> Q.Select a forUpdate s = Q.productQueryArr $ do-  (a, query) <- Q.runSimpleQueryArr' s ()+  (a, query) <- Q.runSimpleSelect s   pure (a, PQ.ForUpdate query)

@@ -147,15 +147,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' $ \() -> do+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 true = HPQ.ConstExpr (HPQ.BoolLit True)-    (r, right) <- flip IQ.runSimpleQueryArr' () $ proc () -> do+    (r, right) <- IQ.runSimpleSelect $ proc () -> do           a <- query -< ()           true_ <- Rebind.rebind -< Opaleye.Field.toNullable (IC.Column true)           returnA -< f true_ a-    pure (r, true, right)+    pure $ \() -> (r, true, right)   -- | An example to demonstrate how the functionality of (lateral)

@@ -25,10 +25,10 @@ import qualified Data.Profunctor.Product.Default as D  restrict :: S.SelectArr (F.Field T.SqlBool) ()-restrict = QA.QueryArr f where+restrict = QA.selectArr 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) = pure ((), PQ.aRestrict predicate)+  f = pure (\(Column predicate) -> ((), PQ.aRestrict predicate))  infix 4 .== (.==) :: forall columns. D.Default EqPP columns columns@@ -103,12 +103,13 @@                            -> (a -> HPQ.PrimExpr)                            -> QA.QueryArr a columns relationValuedExprExplicit rem_ strings pe =-  QA.productQueryArr' $ \a -> do+  QA.productQueryArr' $ do     tag <- Tag.fresh-    let (primExprs, projcols) = runRelExprMaker rem_ tag strings-        primQ :: PQ.PrimQuery-        primQ = PQ.RelExpr (pe a) projcols-    pure (primExprs, primQ)+    pure $ \a ->+      let (primExprs, projcols) = runRelExprMaker rem_ tag strings+          primQ :: PQ.PrimQuery+          primQ = PQ.RelExpr (pe a) projcols+      in (primExprs, primQ)  relationValuedExpr :: D.Default RelExprMaker strings columns                    => strings

@@ -33,28 +33,47 @@ type QueryArr = SelectArr type Query = SelectArr () +selectArr :: State Tag (a -> (b, PQ.PrimQueryArr)) -> SelectArr a b+selectArr s = QueryArr (\a -> fmap ($ a) s)+ productQueryArr :: State Tag (a, PQ.PrimQuery) -> Query a-productQueryArr f = productQueryArr' (\() -> f)+productQueryArr f = productQueryArr' (fmap const f) -productQueryArr' :: (a -> State Tag (b, PQ.PrimQuery)) -> QueryArr a b+productQueryArr' :: State Tag (a -> (b, PQ.PrimQuery)) -> QueryArr a b productQueryArr' f = QueryArr $ \a -> do-  (b, pq) <- f a-  pure (b, PQ.aProduct pq)+  t <- f+  pure $+    let (b, pq) = t a+    in (b, PQ.aProduct pq) -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')+leftJoinQueryArr' :: State Tag (a -> (b, HPQ.PrimExpr, PQ.PrimQuery)) -> QueryArr a b+leftJoinQueryArr' f = selectArr $ do+  t <- f+  pure $ \a ->+    let (a1, cond, primQuery') = t a+    in (a1, PQ.aLeftJoin cond primQuery') +runSimpleSelect :: Select a -> State Tag (a, PQ.PrimQuery)+runSimpleSelect s = runSimpleQueryArr' s ()+ runSimpleQueryArr' :: QueryArr a b -> a -> State Tag (b, PQ.PrimQuery) runSimpleQueryArr' f a = do   (b, pqf) <- unQueryArr f a   pure (b, PQ.toPrimQuery pqf) +-- This is used by Rel8, but at some point it should switch to+-- runSimpleQueryArr' instead. 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')++-- This is used by Rel8, but at some point it should switch to+-- selectArr instead.+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 =

@@ -4,7 +4,7 @@  import Data.Profunctor.Product.Default (Default, def) import Opaleye.Internal.Unpackspec (Unpackspec, runUnpackspec)-import Opaleye.Internal.QueryArr (SelectArr(QueryArr))+import Opaleye.Internal.QueryArr (selectArr, SelectArr) import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.Tag as Tag@@ -16,7 +16,8 @@ rebindExplicit = rebindExplicitPrefix "rebind"  rebindExplicitPrefix :: String -> Unpackspec a b -> SelectArr a b-rebindExplicitPrefix prefix u = QueryArr $ \a -> do+rebindExplicitPrefix prefix u = selectArr $ do   tag <- Tag.fresh-  let (b, bindings) = PM.run (runUnpackspec u (PM.extractAttr prefix tag) a)-  pure (b, PQ.aRebind bindings)+  pure $ \a ->+    let (b, bindings) = PM.run (runUnpackspec u (PM.extractAttr prefix tag) a)+    in (b, PQ.aRebind bindings)

@@ -14,8 +14,8 @@  -- | Add a commented label to the generated SQL. label' :: String -> S.Select ()-label' l = Q.QueryArr f where-  f () = pure ((), PQ.aLabel l)+label' l = Q.selectArr 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

@@ -58,7 +58,7 @@ orderBy :: O.Order a -> S.Select a -> S.Select a orderBy os q =   Q.productQueryArr $ do-    a_pq <- Q.runSimpleQueryArr' q ()+    a_pq <- Q.runSimpleSelect q     pure (O.orderByU os a_pq)  -- | Specify an ascending ordering by the given expression.@@ -117,7 +117,7 @@ -} limit :: Int -> S.Select a -> S.Select a limit n a = Q.productQueryArr $ do-  a_pq <- Q.runSimpleQueryArr' a ()+  a_pq <- Q.runSimpleSelect a   pure (O.limit' n a_pq)  {- |@@ -129,7 +129,7 @@ -} offset :: Int -> S.Select a -> S.Select a offset n a = Q.productQueryArr $ do-  a_pq <- Q.runSimpleQueryArr' a ()+  a_pq <- Q.runSimpleSelect a   pure (O.offset' n a_pq)  -- * Distinct on@@ -191,7 +191,7 @@                    -> S.Select a                    -> S.Select a distinctOnExplicit unpack proj q = Q.productQueryArr $ do-  a_pq <- Q.runSimpleQueryArr' q ()+  a_pq <- Q.runSimpleSelect q   pure (O.distinctOn unpack proj a_pq)  distinctOnByExplicit :: U.Unpackspec b b@@ -200,5 +200,5 @@                      -> S.Select a                      -> S.Select a distinctOnByExplicit unpack proj ord q = Q.productQueryArr $ do-  a_pq <- Q.runSimpleQueryArr' q ()+  a_pq <- Q.runSimpleSelect q   pure (O.distinctOnBy unpack proj ord a_pq)

@@ -18,7 +18,7 @@ import Opaleye.Internal.PackMap (PackMap (..)) import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.PrimQuery as PQ-import Opaleye.Internal.QueryArr (Select, productQueryArr, runSimpleQueryArr')+import Opaleye.Internal.QueryArr (Select, productQueryArr, runSimpleSelect) import qualified Opaleye.Internal.Sql as Sql import qualified Opaleye.Internal.Tag as Tag import Opaleye.Internal.Unpackspec (Unpackspec (..), runUnpackspec)@@ -59,8 +59,8 @@   let rhsSelect' = rhsSelect selectCte   let bodySelect' = bodySelect selectCte -  (_, rhsQ) <- runSimpleQueryArr' rhsSelect' ()-  bodyQ <- runSimpleQueryArr' bodySelect' ()+  (_, rhsQ) <- runSimpleSelect rhsSelect'+  bodyQ <- runSimpleSelect bodySelect'    pure (withCte recursive rhsQ bodyQ)