Skip to content

Commit

Permalink
Merge pull request #2324 from robx/ghc92
Browse files Browse the repository at this point in the history
Update GHC to 9.2.2 (fixes #2288)
  • Loading branch information
robx authored Jun 16, 2022
2 parents 86574c8 + 478c48c commit fe8b32d
Show file tree
Hide file tree
Showing 16 changed files with 169 additions and 112 deletions.
2 changes: 1 addition & 1 deletion default.nix
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 8 additions & 8 deletions nix/hsie/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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 "
Expand All @@ -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) ->
Expand Down
19 changes: 19 additions & 0 deletions nix/overlays/haskell-packages.nix
Original file line number Diff line number Diff line change
Expand Up @@ -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
{
Expand Down
1 change: 1 addition & 0 deletions nix/static-haskell-package.nix
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
28 changes: 15 additions & 13 deletions postgrest.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/PostgREST/App.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
4 changes: 3 additions & 1 deletion src/PostgREST/Query/QueryBuilder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion src/PostgREST/Query/SqlFragment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand All @@ -61,7 +62,7 @@ import PostgREST.Request.Types (Alias, Field, Filter (..),
Operation (..),
OrderDirection (..),
OrderNulls (..),
OrderTerm (..), SelectItem,
OrderTerm (..),
SimpleOperator (..),
TrileanVal (..))

Expand Down
13 changes: 7 additions & 6 deletions src/PostgREST/RangeQuery.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 4 additions & 2 deletions src/PostgREST/Request/DbRequestBuilder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down
45 changes: 45 additions & 0 deletions src/PostgREST/Request/MutateQuery.hs
Original file line number Diff line number Diff line change
@@ -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]
}
22 changes: 12 additions & 10 deletions src/PostgREST/Request/QueryParams.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
Loading

0 comments on commit fe8b32d

Please sign in to comment.