jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #2324 from robx/ghc92

Browse Source 
Update GHC to 9.2.2 (fixes #2288)
This commit is contained in:
Robert
2022-06-16 18:45:10 +02:00
committed by GitHub
parent 86574c89a8 478c48cc84
commit fe8b32d077
16 changed files with 169 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
default.nix
+1 -1
View File
@@ -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
nix/hsie/Main.hs
+8 -8
View File
@@ -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) ->
nix/overlays/haskell-packages.nix
+19
View File
@@ -70,6 +70,25 @@ 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=";
}
{ };
weeder =
lib.dontCheck (prev.callHackageDirect
{
pkg = "weeder";
ver = "2.4.0";
sha256 = "sha256-Nhp8EogHJ5SIr67060TPEvQbN/ECg3cRJFQnUtJUyC0=";
}
{ });
} // extraOverrides final prev;
in
{
nix/static-haskell-package.nix
+1
View File
@@ -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
postgrest.cabal
+15 -13
View File
@@ -62,19 +62,21 @@ 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
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 +95,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 +108,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 +149,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 +212,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 +228,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 +255,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 +270,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 +290,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
src/PostgREST/App.hs
+1 -1
View File
@@ -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)
src/PostgREST/Query/QueryBuilder.hs
+3 -1
View File
@@ -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
src/PostgREST/Query/SqlFragment.hs
+2 -1
View File
@@ -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 (..))
src/PostgREST/RangeQuery.hs
+7 -6
View File
@@ -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
src/PostgREST/Request/DbRequestBuilder.hs
+4 -2
View File
@@ -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
src/PostgREST/Request/MutateQuery.hs
+45
View File
@@ -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]
}
src/PostgREST/Request/QueryParams.hs
+12 -10
View File
@@ -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)
src/PostgREST/Request/ReadQuery.hs
+48
View File
@@ -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
src/PostgREST/Request/Types.hs
+1 -67
View File
@@ -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
test/spec/Feature/Query/InsertSpec.hs
+1 -1
View File
@@ -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":"￥" } ]|]
test/spec/SpecHelper.hs
+1 -1
View File
@@ -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