From 356bff9cbd72255b860fcad7b55b08543c979ea8 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 24 May 2022 18:51:07 +0200 Subject: [PATCH 1/9] cabal: relax upper bounds to allow GHC 9.2 --- postgrest.cabal | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index 2c6fb8eaa..749cf7963 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -68,13 +68,13 @@ library PostgREST.Version PostgREST.Workers other-modules: Paths_postgrest - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , HTTP >= 4000.3.7 && < 4000.4 , Ranged-sets >= 0.3 && < 0.5 , aeson >= 2.0.3 && < 2.1 , auto-update >= 0.1.4 && < 0.2 , base64-bytestring >= 1 && < 1.3 - , bytestring >= 0.10.8 && < 0.11 + , bytestring >= 0.10.8 && < 0.12 , case-insensitive >= 1.2 && < 1.3 , cassava >= 0.4.5 && < 0.6 , configurator-pg >= 0.2 && < 0.3 @@ -93,7 +93,7 @@ library , insert-ordered-containers >= 0.2.2 && < 0.3 , interpolatedstring-perl6 >= 1 && < 1.1 , jose >= 0.8.5.1 && < 0.10 - , lens >= 4.14 && < 5.1 + , lens >= 4.14 && < 5.2 , lens-aeson >= 1.0.1 && < 1.2 , mtl >= 2.2.2 && < 2.3 , network >= 2.6 && < 3.2 @@ -106,7 +106,7 @@ library , scientific >= 0.3.4 && < 0.4 , swagger2 >= 2.4 && < 2.9 , text >= 1.2.2 && < 1.3 - , time >= 1.6 && < 1.11 + , time >= 1.6 && < 1.12 , unordered-containers >= 0.2.8 && < 0.3 , vault >= 0.3.1.5 && < 0.4 , vector >= 0.11 && < 0.13 @@ -147,7 +147,7 @@ executable postgrest NoImplicitPrelude hs-source-dirs: main main-is: Main.hs - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , containers >= 0.5.7 && < 0.7 , postgrest , protolude >= 0.3.1 && < 0.4 @@ -210,13 +210,13 @@ test-suite spec Feature.RpcPreRequestGucsSpec SpecHelper TestTypes - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , aeson >= 2.0.3 && < 2.1 , aeson-qq >= 0.8.1 && < 0.9 , async >= 2.1.1 && < 2.3 , auto-update >= 0.1.4 && < 0.2 , base64-bytestring >= 1 && < 1.3 - , bytestring >= 0.10.8 && < 0.11 + , bytestring >= 0.10.8 && < 0.12 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5.7 && < 0.7 , hasql-pool >= 0.5 && < 0.6 @@ -226,7 +226,7 @@ test-suite spec , hspec-wai >= 0.10 && < 0.12 , hspec-wai-json >= 0.10 && < 0.12 , http-types >= 0.12.3 && < 0.13 - , lens >= 4.14 && < 5.1 + , lens >= 4.14 && < 5.2 , lens-aeson >= 1.0.1 && < 1.2 , monad-control >= 1.0.1 && < 1.1 , postgrest @@ -253,10 +253,10 @@ test-suite querycost hs-source-dirs: test/spec main-is: QueryCost.hs other-modules: SpecHelper - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , aeson >= 2.0.3 && < 2.1 , base64-bytestring >= 1 && < 1.3 - , bytestring >= 0.10.8 && < 0.11 + , bytestring >= 0.10.8 && < 0.12 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5.7 && < 0.7 , contravariant >= 1.4 && < 1.6 @@ -268,7 +268,7 @@ test-suite querycost , hspec >= 2.3 && < 2.9 , hspec-wai >= 0.10 && < 0.12 , http-types >= 0.12.3 && < 0.13 - , lens >= 4.14 && < 5.1 + , lens >= 4.14 && < 5.2 , lens-aeson >= 1.0.1 && < 1.2 , postgrest , process >= 1.4.2 && < 1.7 @@ -288,7 +288,7 @@ test-suite doctests NoImplicitPrelude hs-source-dirs: test/doc main-is: Main.hs - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , doctest >= 0.8 , postgrest , pretty-simple From ba87a60a47b85e841542b8fca24d570637cdcffd Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 15:00:57 +0200 Subject: [PATCH 2/9] rangeParse: fix incomplete pattern match warning The warning is new in GHC 9.2 compared to 8.10. --- src/PostgREST/RangeQuery.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/PostgREST/RangeQuery.hs b/src/PostgREST/RangeQuery.hs index bbe7b3df4..f37cfc393 100644 --- a/src/PostgREST/RangeQuery.hs +++ b/src/PostgREST/RangeQuery.hs @@ -36,13 +36,14 @@ rangeParse :: BS.ByteString -> NonnegRange rangeParse range = do let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString - case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of - Just parsedRange -> - let [_, mLower, mUpper] = readMaybe . BS.unpack <$> parsedRange - lower = maybe emptyRange rangeGeq mLower - upper = maybe allRange rangeLeq mUpper in + case range =~ rangeRegex :: [[BS.ByteString]] of + [[_, l, u]] -> + let lower = maybe emptyRange rangeGeq (readInteger l) + upper = maybe allRange rangeLeq (readInteger u) in rangeIntersection lower upper - Nothing -> allRange + _ -> allRange + where + readInteger = readMaybe . BS.unpack rangeRequested :: RequestHeaders -> NonnegRange rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers From f5827982760b09e97e6f6fcb2602d7f3485e286f Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 16:37:07 +0200 Subject: [PATCH 3/9] ReadQuery: split out to fix record field warning The use of `where_` in DbRequestBuilder issues a warning since GHC 9.2 as per https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0366-no-ambiguous-field-access.rst To disambiguate that, move the type to a separate module and use the record field names qualified. For symmetry, MutateQuery also gets its own module. --- postgrest.cabal | 4 +- src/PostgREST/App.hs | 2 +- src/PostgREST/Query/QueryBuilder.hs | 4 +- src/PostgREST/Query/SqlFragment.hs | 3 +- src/PostgREST/Request/DbRequestBuilder.hs | 6 +- src/PostgREST/Request/MutateQuery.hs | 45 +++++++++++++++ src/PostgREST/Request/QueryParams.hs | 22 ++++---- src/PostgREST/Request/ReadQuery.hs | 48 ++++++++++++++++ src/PostgREST/Request/Types.hs | 68 +---------------------- 9 files changed, 119 insertions(+), 83 deletions(-) create mode 100644 src/PostgREST/Request/MutateQuery.hs create mode 100644 src/PostgREST/Request/ReadQuery.hs diff --git a/postgrest.cabal b/postgrest.cabal index 749cf7963..1663009dd 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -62,9 +62,11 @@ library PostgREST.RangeQuery PostgREST.Request.ApiRequest PostgREST.Request.DbRequestBuilder + PostgREST.Request.MutateQuery PostgREST.Request.Preferences - PostgREST.Request.Types PostgREST.Request.QueryParams + PostgREST.Request.ReadQuery + PostgREST.Request.Types PostgREST.Version PostgREST.Workers other-modules: Paths_postgrest diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index a3f79e905..afd97fdf5 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -82,7 +82,7 @@ import PostgREST.Request.Preferences (PreferCount (..), PreferRepresentation (..), toAppliedHeader) import PostgREST.Request.QueryParams (QueryParams (..)) -import PostgREST.Request.Types (ReadRequest, fstFieldNames) +import PostgREST.Request.ReadQuery (ReadRequest, fstFieldNames) import PostgREST.Version (prettyVersion) import PostgREST.Workers (connectionWorker, listener) diff --git a/src/PostgREST/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index 0c794cf71..a114892c8 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -28,7 +28,9 @@ import PostgREST.DbStructure.Relationship (Cardinality (..), import PostgREST.Request.Preferences (PreferResolution (..)) import PostgREST.Query.SqlFragment -import PostgREST.RangeQuery (allRange) +import PostgREST.RangeQuery (allRange) +import PostgREST.Request.MutateQuery +import PostgREST.Request.ReadQuery import PostgREST.Request.Types import Protolude diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 2ca2e0b99..bff595d90 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -50,6 +50,7 @@ import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..)) import PostgREST.RangeQuery (NonnegRange, allRange, rangeLimit, rangeOffset) +import PostgREST.Request.ReadQuery (SelectItem) import PostgREST.Request.Types (Alias, Field, Filter (..), FtsOperator (..), JoinCondition (..), @@ -61,7 +62,7 @@ import PostgREST.Request.Types (Alias, Field, Filter (..), Operation (..), OrderDirection (..), OrderNulls (..), - OrderTerm (..), SelectItem, + OrderTerm (..), SimpleOperator (..), TrileanVal (..)) diff --git a/src/PostgREST/Request/DbRequestBuilder.hs b/src/PostgREST/Request/DbRequestBuilder.hs index 2ac728c8d..9e9c663f1 100644 --- a/src/PostgREST/Request/DbRequestBuilder.hs +++ b/src/PostgREST/Request/DbRequestBuilder.hs @@ -48,7 +48,9 @@ import PostgREST.Request.ApiRequest (Action (..), Mutation (..), Payload (..)) +import PostgREST.Request.MutateQuery import PostgREST.Request.Preferences +import PostgREST.Request.ReadQuery as ReadQuery import PostgREST.Request.Types import qualified PostgREST.Request.QueryParams as QueryParams @@ -263,7 +265,7 @@ addFilters ApiRequest{..} rReq = addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest addFilterToNode = - updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f) + updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{ReadQuery.where_=addFilterToLogicForest flt lf}, i) f) addOrders :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest addOrders ApiRequest{..} rReq = @@ -295,7 +297,7 @@ addLogicTrees ApiRequest{..} rReq = QueryParams.QueryParams{..} = iQueryParams addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest - addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{where_=t:lf}::ReadQuery, i) f) + addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{ReadQuery.where_=t:lf}, i) f) -- Find a Node of the Tree and apply a function to it updateNode :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest diff --git a/src/PostgREST/Request/MutateQuery.hs b/src/PostgREST/Request/MutateQuery.hs new file mode 100644 index 000000000..cf0e62638 --- /dev/null +++ b/src/PostgREST/Request/MutateQuery.hs @@ -0,0 +1,45 @@ +module PostgREST.Request.MutateQuery + ( MutateQuery(..) + , MutateRequest + ) +where + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Set as S + +import PostgREST.DbStructure.Identifiers (FieldName, + QualifiedIdentifier) +import PostgREST.RangeQuery (NonnegRange) +import PostgREST.Request.Preferences (PreferResolution) +import PostgREST.Request.Types (LogicTree, OrderTerm) + +import Protolude + +type MutateRequest = MutateQuery + +data MutateQuery + = Insert + { in_ :: QualifiedIdentifier + , insCols :: S.Set FieldName + , insBody :: Maybe LBS.ByteString + , onConflict :: Maybe (PreferResolution, [FieldName]) + , where_ :: [LogicTree] + , returning :: [FieldName] + } + | Update + { in_ :: QualifiedIdentifier + , updCols :: S.Set FieldName + , updBody :: Maybe LBS.ByteString + , where_ :: [LogicTree] + , pkFilters :: [FieldName] + , mutRange :: NonnegRange + , mutOrder :: [OrderTerm] + , returning :: [FieldName] + } + | Delete + { in_ :: QualifiedIdentifier + , where_ :: [LogicTree] + , mutRange :: NonnegRange + , mutOrder :: [OrderTerm] + , returning :: [FieldName] + } diff --git a/src/PostgREST/Request/QueryParams.hs b/src/PostgREST/Request/QueryParams.hs index d7cb2ed17..f985b398a 100644 --- a/src/PostgREST/Request/QueryParams.hs +++ b/src/PostgREST/Request/QueryParams.hs @@ -44,16 +44,18 @@ import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq, rangeLimit, rangeOffset, restrictRange) -import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field, - Filter (..), FtsOperator (..), - JoinType (..), JsonOperand (..), - JsonOperation (..), JsonPath, ListVal, - LogicOperator (..), LogicTree (..), - OpExpr (..), Operation (..), - OrderDirection (..), OrderNulls (..), - OrderTerm (..), QPError (..), - SelectItem, SimpleOperator (..), - SingleVal, TrileanVal (..)) +import PostgREST.Request.ReadQuery (SelectItem) +import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field, + Filter (..), FtsOperator (..), + JoinType (..), JsonOperand (..), + JsonOperation (..), JsonPath, + ListVal, LogicOperator (..), + LogicTree (..), OpExpr (..), + Operation (..), + OrderDirection (..), + OrderNulls (..), OrderTerm (..), + QPError (..), SimpleOperator (..), + SingleVal, TrileanVal (..)) import Protolude hiding (try) diff --git a/src/PostgREST/Request/ReadQuery.hs b/src/PostgREST/Request/ReadQuery.hs new file mode 100644 index 000000000..8cdf3d4c3 --- /dev/null +++ b/src/PostgREST/Request/ReadQuery.hs @@ -0,0 +1,48 @@ +module PostgREST.Request.ReadQuery + ( ReadNode + , ReadQuery(..) + , ReadRequest + , SelectItem + , fstFieldNames + ) where + +import Data.Tree (Tree (..)) + +import PostgREST.DbStructure.Identifiers (FieldName, + QualifiedIdentifier) +import PostgREST.DbStructure.Relationship (Relationship) +import PostgREST.RangeQuery (NonnegRange) +import PostgREST.Request.Types (Alias, Cast, Depth, Field, + Hint, JoinCondition, + JoinType, LogicTree, + NodeName, OrderTerm) + + +import Protolude + +type ReadRequest = Tree ReadNode + +type ReadNode = + (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth)) + +-- | The select value in `/tbl?select=alias:field::cast` +type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType) + +data ReadQuery = Select + { select :: [SelectItem] + , from :: QualifiedIdentifier + -- ^ A table alias is used in case of self joins + , fromAlias :: Maybe Alias + -- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins. + , implicitJoins :: [QualifiedIdentifier] + , where_ :: [LogicTree] + , joinConditions :: [JoinCondition] + , order :: [OrderTerm] + , range_ :: NonnegRange + } + deriving (Eq) + +-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d)) +fstFieldNames :: ReadRequest -> [FieldName] +fstFieldNames (Node (sel, _) _) = + fst . (\(f, _, _, _, _) -> f) <$> select sel diff --git a/src/PostgREST/Request/Types.hs b/src/PostgREST/Request/Types.hs index 315e9aeaa..16c076982 100644 --- a/src/PostgREST/Request/Types.hs +++ b/src/PostgREST/Request/Types.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} module PostgREST.Request.Types ( Alias + , Cast , Depth , EmbedParam(..) , ApiRequestError(..) @@ -19,8 +20,6 @@ module PostgREST.Request.Types , ListVal , LogicOperator(..) , LogicTree(..) - , MutateQuery(..) - , MutateRequest , NodeName , OpExpr(..) , Operation (..) @@ -28,21 +27,13 @@ module PostgREST.Request.Types , OrderNulls(..) , OrderTerm(..) , QPError(..) - , ReadNode - , ReadQuery(..) - , ReadRequest - , SelectItem , SingleVal , TrileanVal(..) - , fstFieldNames , SimpleOperator(..) , FtsOperator(..) ) where import qualified Data.ByteString.Lazy as LBS -import qualified Data.Set as S - -import Data.Tree (Tree (..)) import PostgREST.ContentType (ContentType (..)) import PostgREST.DbStructure.Identifiers (FieldName, @@ -50,8 +41,6 @@ import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.DbStructure.Proc (ProcDescription (..), ProcParam (..)) import PostgREST.DbStructure.Relationship (Relationship) -import PostgREST.RangeQuery (NonnegRange) -import PostgREST.Request.Preferences (PreferResolution) import Protolude @@ -76,30 +65,11 @@ data ApiRequestError data QPError = QPError Text Text -type ReadRequest = Tree ReadNode -type MutateRequest = MutateQuery type CallRequest = CallQuery -type ReadNode = - (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth)) - type NodeName = Text type Depth = Integer -data ReadQuery = Select - { select :: [SelectItem] - , from :: QualifiedIdentifier - -- ^ A table alias is used in case of self joins - , fromAlias :: Maybe Alias - -- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins. - , implicitJoins :: [QualifiedIdentifier] - , where_ :: [LogicTree] - , joinConditions :: [JoinCondition] - , order :: [OrderTerm] - , range_ :: NonnegRange - } - deriving (Eq) - data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName) @@ -123,33 +93,6 @@ data OrderNulls | OrderNullsLast deriving (Eq) -data MutateQuery - = Insert - { in_ :: QualifiedIdentifier - , insCols :: S.Set FieldName - , insBody :: Maybe LBS.ByteString - , onConflict :: Maybe (PreferResolution, [FieldName]) - , where_ :: [LogicTree] - , returning :: [FieldName] - } - | Update - { in_ :: QualifiedIdentifier - , updCols :: S.Set FieldName - , updBody :: Maybe LBS.ByteString - , where_ :: [LogicTree] - , pkFilters :: [FieldName] - , mutRange :: NonnegRange - , mutOrder :: [OrderTerm] - , returning :: [FieldName] - } - | Delete - { in_ :: QualifiedIdentifier - , where_ :: [LogicTree] - , mutRange :: NonnegRange - , mutOrder :: [OrderTerm] - , returning :: [FieldName] - } - data CallQuery = FunctionCall { funCQi :: QualifiedIdentifier , funCParams :: CallParams @@ -163,9 +106,6 @@ data CallParams = KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2) | OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val) --- | The select value in `/tbl?select=alias:field::cast` -type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType) - type Field = (FieldName, JsonPath) type Cast = Text type Alias = Text @@ -205,12 +145,6 @@ data JsonOperand | JIdx { jVal :: Text } deriving (Eq) --- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d)) -fstFieldNames :: ReadRequest -> [FieldName] -fstFieldNames (Node (sel, _) _) = - fst . (\(f, _, _, _, _) -> f) <$> select sel - - -- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is: -- -- And From 3d65d66b1b1f9a7f6423cc8acfbb6a161cf64c94 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 23:57:36 +0200 Subject: [PATCH 4/9] tests: fix incomplete pattern warnings (GHC 9.2) --- test/spec/Feature/Query/InsertSpec.hs | 2 +- test/spec/SpecHelper.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/spec/Feature/Query/InsertSpec.hs b/test/spec/Feature/Query/InsertSpec.hs index 7a8caddca..18ff34957 100644 --- a/test/spec/Feature/Query/InsertSpec.hs +++ b/test/spec/Feature/Query/InsertSpec.hs @@ -498,7 +498,7 @@ spec actualPgVersion = do [json|[ { "k":"圍棋", "extra":"￥" } ]|] { matchStatus = 201 } - let Just location = lookup hLocation $ simpleHeaders p + Just location <- pure $ lookup hLocation $ simpleHeaders p get location `shouldRespondWith` [json|[ { "k":"圍棋", "extra":"￥" } ]|] diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index 3a01eaa80..d2b07c402 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -52,7 +52,7 @@ validateOpenApiResponse headers = do let respHeaders = simpleHeaders r in respHeaders `shouldSatisfy` \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs - let Just body = decode (simpleBody r) + Just body <- pure $ decode (simpleBody r) Just schema <- liftIO $ decode <$> BL.readFile "test/spec/fixtures/openapi.json" let args :: M.Map Text Value args = M.fromList From f3cbab6f8211cc1aee7c7745f1db85a5d79924c0 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 15:01:05 +0200 Subject: [PATCH 5/9] nix: use GHC 9.2.2 --- default.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/default.nix b/default.nix index 52c9ea705..c057494c1 100644 --- a/default.nix +++ b/default.nix @@ -3,7 +3,7 @@ let "postgrest"; compiler = - "ghc8107"; + "ghc922"; # PostgREST source files, filtered based on the rules in the .gitignore files # and file extensions. We want to include as litte as possible, as the files From c25473e001b5dc6ad28cb40bd02da69fbf00c672 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 15:01:32 +0200 Subject: [PATCH 6/9] nix: upgrade ptr to 0.16.8.2 (GHC 9.2 compatible) --- nix/overlays/haskell-packages.nix | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/nix/overlays/haskell-packages.nix b/nix/overlays/haskell-packages.nix index 33a5a3cac..35807545c 100644 --- a/nix/overlays/haskell-packages.nix +++ b/nix/overlays/haskell-packages.nix @@ -70,6 +70,16 @@ let hspec-wai-json = lib.dontCheck (lib.unmarkBroken prev.hspec-wai-json); + + ptr = + prev.callHackageDirect + { + pkg = "ptr"; + ver = "0.16.8.2"; + sha256 = "sha256-Ei2GeQ0AjoxvsvmWbdPELPLtSaowoaj9IzsIiySgkAQ="; + } + { }; + } // extraOverrides final prev; in { From 93210f938055ca2e0131daf340dcb51446177dba Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 17:27:33 +0200 Subject: [PATCH 7/9] nix: upgrade weeder to 2.4.0 (GHC 9.2 compatible) --- nix/overlays/haskell-packages.nix | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/nix/overlays/haskell-packages.nix b/nix/overlays/haskell-packages.nix index 35807545c..f3d3a7f35 100644 --- a/nix/overlays/haskell-packages.nix +++ b/nix/overlays/haskell-packages.nix @@ -80,6 +80,15 @@ let } { }; + weeder = + lib.dontCheck (prev.callHackageDirect + { + pkg = "weeder"; + ver = "2.4.0"; + sha256 = "sha256-Nhp8EogHJ5SIr67060TPEvQbN/ECg3cRJFQnUtJUyC0="; + } + { }); + } // extraOverrides final prev; in { From c9c64fd71f2e51d1823ca77f81686007eb061e86 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 19:09:24 +0200 Subject: [PATCH 8/9] nix: update hsie for GHC 9.2 --- nix/hsie/Main.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/nix/hsie/Main.hs b/nix/hsie/Main.hs index 4ef6084c7..b3a52c55d 100644 --- a/nix/hsie/Main.hs +++ b/nix/hsie/Main.hs @@ -24,21 +24,22 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Dot import qualified GHC +import qualified GHC.Paths import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint import qualified Options.Applicative as O import qualified System.FilePath as FP -import Bag (bagToList) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Function ((&)) import Data.List (intercalate) import Data.Maybe (catMaybes, mapMaybe) import Data.Text (Text) +import GHC.Data.Bag (bagToList) import GHC.Generics (Generic) import GHC.Hs.Extension (GhcPs) -import Module (moduleNameString) -import OccName (occNameString) -import RdrName (rdrNameOcc) +import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Reader (rdrNameOcc) +import GHC.Unit.Module.Name (moduleNameString) import System.Directory.Recursive (getFilesRecursive) import System.Exit (exitFailure) @@ -197,11 +198,11 @@ sourceSymbols source = do return $ concatMap (importSymbols source filepath . GHC.unLoc) hsmodImports -- | Parse a Haskell module -parseModule :: String -> IO (GHC.HsModule GhcPs) +parseModule :: FilePath -> IO GHC.HsModule parseModule filepath = do - result <- ExactPrint.parseModule filepath + result <- ExactPrint.parseModule GHC.Paths.libdir filepath case result of - Right (_, hsmod) -> + Right hsmod -> return $ GHC.unLoc hsmod Left errs -> fail $ "Errors with " <> show filepath <> ":\n " @@ -212,7 +213,6 @@ parseModule filepath = do -- If the import is a wildcard, i.e. no symbols are selected for import, then -- only one item is returned. importSymbols :: FilePath -> FilePath -> GHC.ImportDecl GhcPs -> [ImportedSymbol] -importSymbols _ _ (GHC.XImportDecl _) = mempty importSymbols source filepath GHC.ImportDecl{..} = case ideclHiding of Just (hiding, syms) -> From 478c48cc8400a75a6770616f027ab8e09f0b88d4 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Tue, 14 Jun 2022 22:10:33 +0200 Subject: [PATCH 9/9] nix: define GHC 9.2.2's Cabal version for static build --- nix/static-haskell-package.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/nix/static-haskell-package.nix b/nix/static-haskell-package.nix index 6710764cc..69c0caccd 100644 --- a/nix/static-haskell-package.nix +++ b/nix/static-haskell-package.nix @@ -58,6 +58,7 @@ let defaultCabalPackageVersionComingWithGhc = { ghc8107 = "Cabal_3_2_1_0"; + ghc922 = "Cabal_3_6_3_0"; }."${compiler}"; # The static-haskell-nix 'survey' derives a full static set of Haskell