diff --git a/nix/sources.json b/nix/sources.json index 68fa5d7d..bee4db42 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -5,10 +5,10 @@ "homepage": "https://input-output-hk.github.io/haskell.nix", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "bfb828ccb8621613677a9c226f65e3b46f3ef4ce", - "sha256": "0jx0bfm9zi3rav1s807y4nqvm3g487rj4bgxri7yyqq7z2cmpsnm", + "rev": "f3b66b194cd95bfd269a29f89b686eb62269a2b4", + "sha256": "16nk8ahn1n8fg24zrxj4bp4zrmacdw11zhjk80r5fnmshm232s47", "type": "tarball", - "url": "https://github.com/input-output-hk/haskell.nix/archive/bfb828ccb8621613677a9c226f65e3b46f3ef4ce.tar.gz", + "url": "https://github.com/input-output-hk/haskell.nix/archive/f3b66b194cd95bfd269a29f89b686eb62269a2b4.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "niv": { diff --git a/rel8.cabal b/rel8.cabal index 68698a76..72a1f80d 100644 --- a/rel8.cabal +++ b/rel8.cabal @@ -27,7 +27,7 @@ library , comonad , contravariant , hasql ^>= 1.4.5.1 || ^>= 1.5.0.0 - , opaleye ^>= 0.9.0.0 + , opaleye ^>= 0.9.1.0 , pretty , profunctors , product-profunctors diff --git a/src/Rel8/Query.hs b/src/Rel8/Query.hs index 1d146d78..e61f0213 100644 --- a/src/Rel8/Query.hs +++ b/src/Rel8/Query.hs @@ -15,7 +15,7 @@ import Prelude -- opaleye import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye import qualified Opaleye.Internal.PackMap as Opaleye -import qualified Opaleye.Internal.PrimQuery as Opaleye +import qualified Opaleye.Internal.PrimQuery as Opaleye hiding (lateral) import qualified Opaleye.Internal.QueryArr as Opaleye import qualified Opaleye.Internal.Tag as Opaleye @@ -175,14 +175,14 @@ instance Bind Query where instance Monad Query where - Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, tag) -> + Query q >>= f = Query $ \dummies -> Opaleye.stateQueryArr $ \_ tag -> let - Opaleye.QueryArr qa = q dummies - ((m, a), query, tag') = qa ((), tag) + qa = q dummies + ((m, a), query, tag') = Opaleye.runStateQueryArr qa () tag Query q' = f a (dummies', query', tag'') = ( dummy : dummies - , \lateral -> Opaleye.Rebind True bindings . query lateral + , query <> Opaleye.aRebind bindings , Opaleye.next tag' ) where @@ -190,11 +190,11 @@ instance Monad Query where where random = Opaleye.FunExpr "random" [] name = Opaleye.extractAttr "dummy" tag' - Opaleye.QueryArr qa' = Opaleye.lateral $ \_ -> q' dummies' - ((m'@(Any needsDummies), b), query'', tag''') = qa' ((), tag'') + qa' = Opaleye.lateral $ \_ -> q' dummies' + ((m'@(Any needsDummies), b), query'', tag''') = Opaleye.runStateQueryArr qa' () tag'' query''' - | needsDummies = \lateral -> query'' lateral . query' lateral - | otherwise = \lateral -> query'' lateral . query lateral + | needsDummies = query' <> query'' + | otherwise = query <> query'' m'' = m <> m' in ((m'', b), query''', tag''') diff --git a/src/Rel8/Query/Distinct.hs b/src/Rel8/Query/Distinct.hs index 3d069fc0..f0705b54 100644 --- a/src/Rel8/Query/Distinct.hs +++ b/src/Rel8/Query/Distinct.hs @@ -11,8 +11,8 @@ where import Prelude -- opaleye -import qualified Opaleye.Distinct as Opaleye hiding ( distinctOn, distinctOnBy ) -import qualified Opaleye.Internal.Order as Opaleye +import qualified Opaleye.Distinct as Opaleye +import qualified Opaleye.Order as Opaleye import qualified Opaleye.Internal.QueryArr as Opaleye -- rel8 @@ -33,13 +33,11 @@ distinct = mapOpaleye (Opaleye.distinctExplicit distinctspec) -- to a projection. If multiple rows have the same projection, it is -- unspecified which row will be returned. If this matters, use 'distinctOnBy'. distinctOn :: EqTable b => (a -> b) -> Query a -> Query a -distinctOn proj = - mapOpaleye (\q -> Opaleye.productQueryArr (Opaleye.distinctOn unpackspec proj . Opaleye.runSimpleQueryArr q)) +distinctOn proj = mapOpaleye (Opaleye.distinctOnExplicit unpackspec proj) -- | Select all distinct rows from a query, where rows are equivalent according -- to a projection. If there are multiple rows with the same projection, the -- first row according to the specified 'Order' will be returned. distinctOnBy :: EqTable b => (a -> b) -> Order a -> Query a -> Query a -distinctOnBy proj (Order order) = - mapOpaleye (\q -> Opaleye.productQueryArr (Opaleye.distinctOnBy unpackspec proj order . Opaleye.runSimpleQueryArr q)) +distinctOnBy proj (Order order) = mapOpaleye (Opaleye.distinctOnByExplicit unpackspec proj order) diff --git a/src/Rel8/Query/Indexed.hs b/src/Rel8/Query/Indexed.hs index 824646b6..2300e119 100644 --- a/src/Rel8/Query/Indexed.hs +++ b/src/Rel8/Query/Indexed.hs @@ -23,12 +23,12 @@ import Rel8.Query.Opaleye ( mapOpaleye ) -- | Pair each row of a query with its index within the query. indexed :: Query a -> Query (Expr Int64, a) -indexed = mapOpaleye $ \(Opaleye.QueryArr f) -> Opaleye.QueryArr $ \(_, tag) -> +indexed = mapOpaleye $ \f -> Opaleye.stateQueryArr $ \_ tag -> let - (a, query, tag') = f ((), tag) + (a, query, tag') = Opaleye.runStateQueryArr f () tag tag'' = Opaleye.next tag' window = Opaleye.ConstExpr $ Opaleye.OtherLit "ROW_NUMBER() OVER () - 1" (index, bindings) = Opaleye.run $ Opaleye.extractAttr "index" tag' window - query' lateral = Opaleye.Rebind True bindings . query lateral + query' = query <> Opaleye.aRebind bindings in ((fromPrimExpr index, a), query', tag'') diff --git a/src/Rel8/Query/Opaleye.hs b/src/Rel8/Query/Opaleye.hs index 28879df3..8e1601b2 100644 --- a/src/Rel8/Query/Opaleye.hs +++ b/src/Rel8/Query/Opaleye.hs @@ -41,30 +41,30 @@ zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b unsafePeekQuery :: Query a -> a unsafePeekQuery (Query q) = case q mempty of - Opaleye.QueryArr f -> case f ((), Opaleye.start) of + f -> case Opaleye.runStateQueryArr f () Opaleye.start of ((_, a), _, _) -> a mapping :: () => (Opaleye.Select a -> Opaleye.Select b) -> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -mapping f q@(Opaleye.QueryArr qa) = Opaleye.QueryArr $ \(_, tag) -> +mapping f q = Opaleye.stateQueryArr $ \_ tag -> let - ((m, _), _, _) = qa ((), tag) - Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q) + ((m, _), _, _) = Opaleye.runStateQueryArr q () tag + q' = (m,) <$> f (snd <$> q) in - qa' ((), tag) + Opaleye.runStateQueryArr q' () tag zipping :: Semigroup m => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c) -> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c) -zipping f q@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') = - Opaleye.QueryArr $ \(_, tag) -> +zipping f q q' = + Opaleye.stateQueryArr $ \_ tag -> let - ((m, _), _, _) = qa ((), tag) - ((m', _), _, _) = qa' ((), tag) + ((m, _), _, _) = Opaleye.runStateQueryArr q () tag + ((m', _), _, _) = Opaleye.runStateQueryArr q' () tag m'' = m <> m' - Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q') + q'' = (m'',) <$> f (snd <$> q) (snd <$> q') in - qa'' ((), tag) + Opaleye.runStateQueryArr q'' () tag diff --git a/src/Rel8/Query/Rebind.hs b/src/Rel8/Query/Rebind.hs index 4cb1f49a..a605aad2 100644 --- a/src/Rel8/Query/Rebind.hs +++ b/src/Rel8/Query/Rebind.hs @@ -7,29 +7,21 @@ where -- base import Prelude +import Control.Arrow ((<<<)) -- opaleye -import qualified Opaleye.Internal.PackMap as Opaleye -import qualified Opaleye.Internal.PrimQuery as Opaleye -import qualified Opaleye.Internal.QueryArr as Opaleye -import qualified Opaleye.Internal.Tag as Opaleye -import qualified Opaleye.Internal.Unpackspec as Opaleye +import qualified Opaleye.Internal.Rebind as Opaleye -- rel8 import Rel8.Expr ( Expr ) -import Rel8.Query ( Query( Query ) ) +import Rel8.Query ( Query ) import Rel8.Table ( Table ) import Rel8.Table.Opaleye ( unpackspec ) +import Rel8.Query.Opaleye (fromOpaleye) -- | 'rebind' takes a variable name, some expressions, and binds each of them -- to a new variable in the SQL. The @a@ returned consists only of these -- variables. It's essentially a @let@ binding for Postgres expressions. rebind :: Table Expr a => String -> a -> Query a -rebind prefix a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) -> - let - tag' = Opaleye.next tag - (a', bindings) = Opaleye.run $ - Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr prefix tag) a - in - ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag') +rebind prefix a = fromOpaleye (Opaleye.rebindExplicitPrefix prefix unpackspec <<< pure a) diff --git a/src/Rel8/Query/These.hs b/src/Rel8/Query/These.hs index c08b4959..05336628 100644 --- a/src/Rel8/Query/These.hs +++ b/src/Rel8/Query/These.hs @@ -48,11 +48,11 @@ import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) ) alignBy :: () => (a -> b -> Expr Bool) -> Query a -> Query b -> Query (TheseTable Expr a b) -alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of - (_, tag) -> (tab, join', tag''') +alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.stateQueryArr $ \_ t -> case t of + tag -> (tab, join', tag''') where - (ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag) - (mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag') + (ma, left', tag') = Opaleye.runStateQueryArr (pure <$> left) () tag + (mb, right', tag'') = Opaleye.runStateQueryArr (pure <$> right) () tag' MaybeTable hasHere a = ma MaybeTable hasThere b = mb (hasHere', lbindings) = Opaleye.run $ do @@ -60,15 +60,15 @@ alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> cas (hasThere', rbindings) = Opaleye.run $ do traversePrimExpr (Opaleye.extractAttr "hasThere" tag'') hasThere tag''' = Opaleye.next tag'' - join lateral = Opaleye.Join Opaleye.FullJoin on left'' right'' + join = Opaleye.Join Opaleye.FullJoin on left'' right'' where on = toPrimExpr $ condition (extract a) (extract b) - left'' = (lateral, Opaleye.Rebind True lbindings left') - right'' = (lateral, Opaleye.Rebind True rbindings right') + left'' = (Opaleye.NonLateral, Opaleye.toPrimQuery (left' <> Opaleye.aRebind lbindings)) + right'' = (Opaleye.NonLateral, Opaleye.toPrimQuery (right' <> Opaleye.aRebind rbindings)) ma' = MaybeTable hasHere' a mb' = MaybeTable hasThere' b tab = TheseTable {here = ma', there = mb'} - join' lateral input = Opaleye.times lateral input (join lateral) + join' = Opaleye.aProduct join keepHereTable :: TheseTable Expr a b -> Query (a, MaybeTable Expr b) diff --git a/src/Rel8/Tabulate.hs b/src/Rel8/Tabulate.hs index 2527a9c5..8cc9a31f 100644 --- a/src/Rel8/Tabulate.hs +++ b/src/Rel8/Tabulate.hs @@ -69,9 +69,7 @@ import Control.Comonad ( extract ) -- opaleye import qualified Opaleye.Aggregate as Opaleye -import qualified Opaleye.Internal.Order as Opaleye -import qualified Opaleye.Internal.QueryArr as Opaleye -import qualified Opaleye.Order as Opaleye ( orderBy ) +import qualified Opaleye.Order as Opaleye ( orderBy, distinctOnExplicit ) -- profunctors import Data.Profunctor ( dimap, lmap ) @@ -350,14 +348,7 @@ distinct (Tabulation f) = Tabulation $ \p -> case fst (unsafePeekQuery (f p)) of Nothing -> limit 1 (f p) Just _ -> - mapOpaleye - (\q -> - Opaleye.productQueryArr - ( Opaleye.distinctOn (key unpackspec) fst - . Opaleye.runSimpleQueryArr q - ) - ) - (f p) + mapOpaleye (Opaleye.distinctOnExplicit (key unpackspec) fst) (f p) -- | 'order' orders the /values/ of a 'Tabulation' within their