From b6e81267ef8a74dbef74a798e143b0461d73c37b Mon Sep 17 00:00:00 2001 From: Shane O'Brien Date: Mon, 15 Jan 2024 15:39:33 +0000 Subject: [PATCH] Update Rel8 to work with Opaleye's #586 --- flake.lock | 78 +++++++++++++++++++++++++++++++------ rel8.cabal | 2 +- src/Rel8/Expr/List.hs | 2 +- src/Rel8/Expr/NonEmpty.hs | 2 +- src/Rel8/Query/Aggregate.hs | 17 ++++++-- src/Rel8/Query/Distinct.hs | 4 +- src/Rel8/Tabulate.hs | 8 ++-- 7 files changed, 88 insertions(+), 25 deletions(-) diff --git a/flake.lock b/flake.lock index 51c09de7..dac1f6e4 100644 --- a/flake.lock +++ b/flake.lock @@ -105,11 +105,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1701680307, - "narHash": "sha256-kAuep2h5ajznlPMD9rnQyffWG8EM/C73lejGofXvdM8=", + "lastModified": 1705309234, + "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=", "owner": "numtide", "repo": "flake-utils", - "rev": "4022d587cbbfd70fe950c1e2083a02621806a725", + "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26", "type": "github" }, "original": { @@ -175,11 +175,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1704673438, - "narHash": "sha256-xKVqD6odU6GUAWfCKmfG4WsSyU/ErMLeUqm5MW7+jUQ=", + "lastModified": 1707438129, + "narHash": "sha256-oBK/L1qbIasOMDm3w4mvIh3q6m6My5MM7wW6BR03OL0=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "3281ef859548b80648c9b105264089ad1828ce17", + "rev": "aea500fc60992c6c376f03dff4cba36569dd3dd4", "type": "github" }, "original": { @@ -205,9 +205,12 @@ "hls-2.2": "hls-2.2", "hls-2.3": "hls-2.3", "hls-2.4": "hls-2.4", + "hls-2.5": "hls-2.5", + "hls-2.6": "hls-2.6", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", + "nix-tools-static": "nix-tools-static", "nixpkgs": [ "haskellNix", "nixpkgs-unstable" @@ -224,11 +227,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1704674979, - "narHash": "sha256-fNHJvulQ7T3SwxRU0TD/HpnpkThWEXfrkQWsXsMFD9w=", + "lastModified": 1707439795, + "narHash": "sha256-a6fWMji+hEAhX5sokxcAz/1y87w4g7It+wFjuk3ldKc=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "e94099dada5fc13da89326308f2db149243aa783", + "rev": "dacec95b753ce83d678c1a5200391c14e18f375d", "type": "github" }, "original": { @@ -322,6 +325,40 @@ "type": "github" } }, + "hls-2.5": { + "flake": false, + "locked": { + "lastModified": 1701080174, + "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.5.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, + "hls-2.6": { + "flake": false, + "locked": { + "lastModified": 1705325287, + "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.6.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hpc-coveralls": { "flake": false, "locked": { @@ -415,6 +452,23 @@ "type": "github" } }, + "nix-tools-static": { + "flake": false, + "locked": { + "lastModified": 1706266250, + "narHash": "sha256-9t+GRk3eO9muCtKdNAwBtNBZ5dH1xHcnS17WaQyftwA=", + "owner": "input-output-hk", + "repo": "haskell-nix-example", + "rev": "580cb6db546a7777dad3b9c0fa487a366c045c4e", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "nix", + "repo": "haskell-nix-example", + "type": "github" + } + }, "nixpkgs": { "locked": { "lastModified": 1657693803, @@ -605,11 +659,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1704672626, - "narHash": "sha256-PtkJGdHmKoB8EmnIGif7gPG5YcUkB3JTSq8hWyG7Q0g=", + "lastModified": 1707437347, + "narHash": "sha256-z6ovlr+MTaiZ9rMs6IG+OJOwyhpU/qRQD/Lse12nkVE=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "9595ebca3d6d0690e0039d2ddf53609e200a11d1", + "rev": "4d220d029dd871c604c2a11b63402e29e290b5fa", "type": "github" }, "original": { diff --git a/rel8.cabal b/rel8.cabal index 9783d136..05e3429f 100644 --- a/rel8.cabal +++ b/rel8.cabal @@ -33,7 +33,7 @@ library , data-textual , hasql ^>= 1.6.1.2 , network-ip - , opaleye ^>= 0.10.2.0 + , opaleye ^>= 0.10.2.1 , pretty , profunctors , product-profunctors diff --git a/src/Rel8/Expr/List.hs b/src/Rel8/Expr/List.hs index 1797b5f8..37363a60 100644 --- a/src/Rel8/Expr/List.hs +++ b/src/Rel8/Expr/List.hs @@ -17,7 +17,7 @@ import Prelude -- rel8 import Rel8.Expr (Expr) -import Rel8.Expr.Opaleye (fromPrimExpr, mapPrimExpr, toPrimExpr) +import Rel8.Expr.Opaleye (mapPrimExpr, toPrimExpr) import Rel8.Schema.Null (Nullify, Sql, Unnullify) import Rel8.Type (DBType, typeInformation) import Rel8.Type.Information (TypeInformation) diff --git a/src/Rel8/Expr/NonEmpty.hs b/src/Rel8/Expr/NonEmpty.hs index 70ff5e77..598f139f 100644 --- a/src/Rel8/Expr/NonEmpty.hs +++ b/src/Rel8/Expr/NonEmpty.hs @@ -18,7 +18,7 @@ import Prelude -- rel8 import Rel8.Expr (Expr) -import Rel8.Expr.Opaleye (fromPrimExpr, mapPrimExpr, toPrimExpr) +import Rel8.Expr.Opaleye (mapPrimExpr, toPrimExpr) import Rel8.Schema.Null (Nullify, Sql, Unnullify) import Rel8.Type (DBType, typeInformation) import Rel8.Type.Information (TypeInformation) diff --git a/src/Rel8/Query/Aggregate.hs b/src/Rel8/Query/Aggregate.hs index 1a5348a5..dfdf9709 100644 --- a/src/Rel8/Query/Aggregate.hs +++ b/src/Rel8/Query/Aggregate.hs @@ -5,6 +5,7 @@ module Rel8.Query.Aggregate ( aggregate , aggregate1 + , aggregateU , countRows ) where @@ -15,6 +16,7 @@ import Data.Int ( Int64 ) import Prelude -- opaleye +import qualified Opaleye.Adaptors as Opaleye import qualified Opaleye.Aggregate as Opaleye -- rel8 @@ -22,29 +24,36 @@ import Rel8.Aggregate (Aggregator' (Aggregator), Aggregator) import Rel8.Aggregate.Fold (Fallback (Fallback)) import Rel8.Expr ( Expr ) import Rel8.Expr.Aggregate ( countStar ) +import Rel8.Expr.Bool (true) import Rel8.Query ( Query ) import Rel8.Query.Maybe ( optional ) import Rel8.Query.Opaleye ( mapOpaleye ) import Rel8.Table (Table) import Rel8.Table.Maybe (fromMaybeTable) +import Rel8.Table.Opaleye (unpackspec) -- | Apply an 'Aggregator' to all rows returned by a 'Query'. If the 'Query' -- is empty, then a single \"fallback\" row is returned, composed of the -- identity elements of the constituent aggregation functions. -aggregate :: Table Expr a => Aggregator i a -> Query i -> Query a +aggregate :: (Table Expr i, Table Expr a) => Aggregator i a -> Query i -> Query a aggregate aggregator@(Aggregator (Fallback fallback) _) = fmap (fromMaybeTable fallback) . optional . aggregate1 aggregator -- | Apply an 'Rel8.Aggregator1' to all rows returned by a 'Query'. If -- the 'Query' is empty, then zero rows are returned. -aggregate1 :: Aggregator' fold i a -> Query i -> Query a -aggregate1 (Aggregator _ aggregator) = mapOpaleye (Opaleye.aggregate aggregator) +aggregate1 :: Table Expr i => Aggregator' fold i a -> Query i -> Query a +aggregate1 = aggregateU unpackspec + + +aggregateU :: Opaleye.Unpackspec i i -> Aggregator' fold i a -> Query i -> Query a +aggregateU unpack (Aggregator _ aggregator) = + mapOpaleye (Opaleye.aggregateExplicit unpack aggregator) -- | Count the number of rows returned by a query. Note that this is different -- from @countStar@, as even if the given query yields no rows, @countRows@ -- will return @0@. countRows :: Query a -> Query (Expr Int64) -countRows = aggregate countStar +countRows = aggregate countStar . (true <$) diff --git a/src/Rel8/Query/Distinct.hs b/src/Rel8/Query/Distinct.hs index 7cb6cf64..270eaa61 100644 --- a/src/Rel8/Query/Distinct.hs +++ b/src/Rel8/Query/Distinct.hs @@ -17,13 +17,13 @@ import Rel8.Order ( Order( Order ) ) import Rel8.Query ( Query ) import Rel8.Query.Opaleye ( mapOpaleye ) import Rel8.Table.Eq ( EqTable ) -import Rel8.Table.Opaleye ( distinctspec, unpackspec ) +import Rel8.Table.Opaleye (distinctspec, unpackspec) -- | Select all distinct rows from a query, removing duplicates. @distinct q@ -- is equivalent to the SQL statement @SELECT DISTINCT q@. distinct :: EqTable a => Query a -> Query a -distinct = mapOpaleye (Opaleye.distinctExplicit distinctspec) +distinct = mapOpaleye (Opaleye.distinctExplicit unpackspec distinctspec) -- | Select all distinct rows from a query, where rows are equivalent according diff --git a/src/Rel8/Tabulate.hs b/src/Rel8/Tabulate.hs index 6c5883fe..9b93e33d 100644 --- a/src/Rel8/Tabulate.hs +++ b/src/Rel8/Tabulate.hs @@ -338,7 +338,7 @@ lookup k (Tabulation f) = do -- the given aggregator, and every other possible key contains a single -- \"fallback\" row is returned, composed of the identity elements of the -- constituent aggregation functions. -aggregate :: (EqTable k, Table Expr a) +aggregate :: (EqTable k, Table Expr i, Table Expr a) => Aggregator i a -> Tabulation k i -> Tabulation k a aggregate aggregator@(Aggregator (Fallback fallback) _) = fmap (fromMaybeTable fallback) . optional . aggregate1 aggregator @@ -346,10 +346,10 @@ aggregate aggregator@(Aggregator (Fallback fallback) _) = -- | 'aggregate1' aggregates the values within each key of a -- 'Tabulation'. There is an implicit @GROUP BY@ on all the key columns. -aggregate1 :: EqTable k +aggregate1 :: (EqTable k, Table Expr i) => Aggregator' fold i a -> Tabulation k i -> Tabulation k a aggregate1 aggregator (Tabulation f) = - Tabulation $ Q.aggregate1 (keyed groupBy (toAggregator1 aggregator)) . f + Tabulation $ Q.aggregateU (keyed unpackspec unpackspec) (keyed groupBy (toAggregator1 aggregator)) . f -- | 'distinct' ensures a 'Tabulation' has at most one value for @@ -416,7 +416,7 @@ order ordering (Tabulation f) = -- The resulting 'Tabulation' is \"magic\" in that the value @0@ exists at -- every possible key that wasn't in the given 'Tabulation'. count :: EqTable k => Tabulation k a -> Tabulation k (Expr Int64) -count = aggregate countStar +count = aggregate countStar . (true <$) -- | 'optional' produces a \"magic\" 'Tabulation' whereby each