fix: compilation on Ubuntu, GHC 9.0.2 compat

This commit is contained in:
steve-chavez
2023-06-21 16:22:30 -05:00
committed by Steve Chavez
parent d9261fa674
commit 40dc46ed2e
3 changed files with 8 additions and 9 deletions
+1
View File
@@ -8,6 +8,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
### Fixed ### Fixed
- #2821, Fix OPTIONS not accepting all available media types - @steve-chavez - #2821, Fix OPTIONS not accepting all available media types - @steve-chavez
- #2834, Fix compilation on Ubuntu by being compatible with GHC 9.0.2 - @steve-chavez
## [11.1.0] - 2023-06-07 ## [11.1.0] - 2023-06-07
+4 -5
View File
@@ -13,7 +13,6 @@ resource.
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module PostgREST.Plan module PostgREST.Plan
@@ -503,10 +502,10 @@ updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
findNode = find (\(Node ReadPlan{relName, relAlias} _) -> relName == targetNodeName || relAlias == Just targetNodeName) forest findNode = find (\(Node ReadPlan{relName, relAlias} _) -> relName == targetNodeName || relAlias == Just targetNodeName) forest
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
mutatePlan mutation qi ApiRequest{iPreferences=preferences, ..} sCache readReq = mapLeft ApiRequestError $ mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} sCache readReq = mapLeft ApiRequestError $
case mutation of case mutation of
MutationCreate -> MutationCreate ->
mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferences.preferResolution <*> Just confCols) [] returnings pkCols applyDefaults) typedColumnsOrError mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferResolution <*> Just confCols) [] returnings pkCols applyDefaults) typedColumnsOrError
MutationUpdate -> MutationUpdate ->
mapRight (\typedColumns -> Update qi typedColumns body combinedLogic iTopLevelRange rootOrder returnings applyDefaults) typedColumnsOrError mapRight (\typedColumns -> Update qi typedColumns body combinedLogic iTopLevelRange rootOrder returnings applyDefaults) typedColumnsOrError
MutationSingleUpsert -> MutationSingleUpsert ->
@@ -524,7 +523,7 @@ mutatePlan mutation qi ApiRequest{iPreferences=preferences, ..} sCache readReq =
confCols = fromMaybe pkCols qsOnConflict confCols = fromMaybe pkCols qsOnConflict
QueryParams.QueryParams{..} = iQueryParams QueryParams.QueryParams{..} = iQueryParams
returnings = returnings =
if preferences.preferRepresentation == None if preferRepresentation == None
then [] then []
else inferColsEmbedNeeds readReq pkCols else inferColsEmbedNeeds readReq pkCols
pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache
@@ -534,7 +533,7 @@ mutatePlan mutation qi ApiRequest{iPreferences=preferences, ..} sCache readReq =
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates) body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
tbl = HM.lookup qi $ dbTables sCache tbl = HM.lookup qi $ dbTables sCache
typedColumnsOrError = resolveOrError tbl `traverse` S.toList iColumns typedColumnsOrError = resolveOrError tbl `traverse` S.toList iColumns
applyDefaults = preferences.preferMissing == Just ApplyDefaults applyDefaults = preferMissing == Just ApplyDefaults
resolveOrError :: Maybe Table -> FieldName -> Either ApiRequestError TypedField resolveOrError :: Maybe Table -> FieldName -> Either ApiRequestError TypedField
resolveOrError Nothing _ = Left NotFound resolveOrError Nothing _ = Left NotFound
+3 -4
View File
@@ -8,7 +8,6 @@ import Network.Wai.Test (SResponse (..))
import Data.Aeson.Lens import Data.Aeson.Lens
import Data.Aeson.QQ import Data.Aeson.QQ
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T import qualified Data.Text as T
import Network.HTTP.Types import Network.HTTP.Types
@@ -66,7 +65,7 @@ spec actualPgVersion = do
liftIO $ do liftIO $ do
resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=buffers; charset=utf-8") resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=buffers; charset=utf-8")
resBody `shouldSatisfy` (\t -> T.isInfixOf "Shared Hit Blocks" (decodeUtf8 $ BS.toStrict t)) resBody `shouldSatisfy` (\t -> T.isInfixOf "Shared Hit Blocks" (decodeUtf8 $ LBS.toStrict t))
else do else do
-- analyze is required for buffers on pg < 13 -- analyze is required for buffers on pg < 13
r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=analyze|buffers") "" r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=analyze|buffers") ""
@@ -338,7 +337,7 @@ spec actualPgVersion = do
let resBody = simpleBody r let resBody = simpleBody r
liftIO $ do liftIO $ do
resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getallusers" (decodeUtf8 $ BS.toStrict t)) resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getallusers" (decodeUtf8 $ LBS.toStrict t))
it "should inline a function with arguments(the function won't appear in the plan tree)" $ do it "should inline a function with arguments(the function won't appear in the plan tree)" $ do
r <- request methodGet "/rpc/getitemrange?min=10&max=15" r <- request methodGet "/rpc/getitemrange?min=10&max=15"
@@ -347,7 +346,7 @@ spec actualPgVersion = do
let resBody = simpleBody r let resBody = simpleBody r
liftIO $ do liftIO $ do
resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getitemrange" (decodeUtf8 $ BS.toStrict t)) resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getitemrange" (decodeUtf8 $ LBS.toStrict t))
disabledSpec :: SpecWith ((), Application) disabledSpec :: SpecWith ((), Application)
disabledSpec = disabledSpec =