postgresql-syntax 0.5.0.1 → 0.5.0.2
raw patch · 197 files changed
+1028/−914 lines, 197 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +13/−0
- bench/Main.hs +1/−1
- hspec-test/Ast/AExprSpec.hs +5/−2
- hspec-test/Ast/CExprSpec.hs +1/−0
- hspec-test/Ast/DeleteStmtSpec.hs +3/−0
- hspec-test/Ast/FrameBoundSpec.hs +2/−2
- hspec-test/Ast/InExprSpec.hs +1/−0
- hspec-test/Ast/IndexElemSpec.hs +2/−2
- hspec-test/Ast/InsertRestSpec.hs +4/−0
- hspec-test/Ast/InsertStmtSpec.hs +2/−0
- hspec-test/Ast/JoinMethSpec.hs +0/−10
- hspec-test/Ast/OpSpec.hs +1/−1
- hspec-test/Ast/PreparableStmtSpec.hs +1/−1
- hspec-test/Ast/SconstSpec.hs +1/−1
- hspec-test/Ast/SelectClauseSpec.hs +2/−0
- hspec-test/Ast/SelectNoParensSpec.hs +2/−0
- hspec-test/Ast/SelectWithParensSpec.hs +3/−2
- hspec-test/Ast/SimpleSelectSpec.hs +36/−0
- hspec-test/Ast/SortBySpec.hs +3/−5
- hspec-test/Ast/TableRefSpec.hs +2/−0
- hspec-test/Ast/TypenameSpec.hs +1/−1
- hspec-test/Ast/UpdateStmtSpec.hs +2/−0
- hspec-test/Ast/WindowSpecificationSpec.hs +1/−1
- hspec-test/Helpers/Expectations.hs +2/−2
- hspec-test/Helpers/Specs.hs +19/−14
- hspec-test/Main.hs +1/−1
- library-internal/PostgresqlSyntax/Algebra.hs +267/−0
- library-internal/PostgresqlSyntax/Ast.hs +0/−2
- library-internal/PostgresqlSyntax/Ast/AExpr.hs +12/−41
- library-internal/PostgresqlSyntax/Ast/AExpr.hs-boot +4/−21
- library-internal/PostgresqlSyntax/Ast/AExprReversableOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/AexprConst.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/AliasClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/AllOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/AnyName.hs +1/−9
- library-internal/PostgresqlSyntax/Ast/AnyOperator.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ArrayBounds.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs-boot +1/−1
- library-internal/PostgresqlSyntax/Ast/ArrayExprList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/AscDesc.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Attrs.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/BExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/BExpr.hs-boot +1/−1
- library-internal/PostgresqlSyntax/Ast/BExprIsOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Bconst.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Bit.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/CExpr.hs +9/−11
- library-internal/PostgresqlSyntax/Ast/CallStmt.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/CaseExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Character.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Columnref.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/CommonTableExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ConfExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ConstCharacter.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ConstDatetime.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ConstTypename.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/DeleteStmt.hs +2/−3
- library-internal/PostgresqlSyntax/Ast/ExplicitRow.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ExprList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ExtractArg.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ExtractList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Fconst.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ForLockingClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ForLockingItem.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ForLockingStrength.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FrameBound.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FrameClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FrameClauseMode.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FrameExtent.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FromClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FromList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncAliasClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncApplication.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncApplicationParams.hs +5/−2
- library-internal/PostgresqlSyntax/Ast/FuncArgExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncConstArgs.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs-boot +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncExprWindowless.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncName.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/FuncTable.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/GenericType.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/GroupByItem.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/GroupClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/HavingClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Iconst.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Ident.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ImplicitRow.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/InExpr.hs +8/−9
- library-internal/PostgresqlSyntax/Ast/IndexElem.hs +2/−8
- library-internal/PostgresqlSyntax/Ast/IndexElemDef.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/IndexParams.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Indirection.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/IndirectionEl.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/InsertColumnItem.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/InsertColumnList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/InsertRest.hs +10/−2
- library-internal/PostgresqlSyntax/Ast/InsertStmt.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/InsertTarget.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Interval.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/IntervalSecond.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/IntoClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/JoinMeth.hs +0/−64
- library-internal/PostgresqlSyntax/Ast/JoinQual.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/JoinType.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/JoinedTable.hs +113/−30
- library-internal/PostgresqlSyntax/Ast/JoinedTable.hs-boot +0/−16
- library-internal/PostgresqlSyntax/Ast/LimitClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/MathOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/NameList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/NullsOrder.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Numeric.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OffsetClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OnConflict.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OnConflictDo.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Op.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OptOrdinality.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OptTempTableName.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OptVarying.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OverClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OverlayList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/OverrideKind.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/PositionList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/PreparableStmt.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/QualAllOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/QualOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/QualifiedName.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/RelationExpr.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/RelationExprOptAlias.hs +12/−20
- library-internal/PostgresqlSyntax/Ast/ReturningClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Row.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/RowsfromItem.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/RowsfromList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Sconst.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SelectBinOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SelectClause.hs +34/−6
- library-internal/PostgresqlSyntax/Ast/SelectClause.hs-boot +1/−1
- library-internal/PostgresqlSyntax/Ast/SelectFetchFirstValue.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SelectLimit.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SelectLimitValue.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs +15/−42
- library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs-boot +3/−8
- library-internal/PostgresqlSyntax/Ast/SelectStmt.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs +20/−53
- library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs-boot +3/−7
- library-internal/PostgresqlSyntax/Ast/SetClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SetClauseList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SetTarget.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SetTargetList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs +133/−85
- library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs-boot +6/−7
- library-internal/PostgresqlSyntax/Ast/SimpleTypename.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SortBy.hs +3/−9
- library-internal/PostgresqlSyntax/Ast/SortClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SubType.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SubqueryOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SubstrList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SubstrListFromFor.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/SymbolicExprBinOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TableFuncElement.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TableFuncElementList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TableRef.hs +83/−183
- library-internal/PostgresqlSyntax/Ast/TableRef.hs-boot +4/−12
- library-internal/PostgresqlSyntax/Ast/TablesampleClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TargetEl.hs +2/−11
- library-internal/PostgresqlSyntax/Ast/TargetList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Targeting.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Timezone.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TrimList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TrimModifier.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TypeList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/Typename.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/TypenameArrayDimensions.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/UpdateStmt.hs +2/−3
- library-internal/PostgresqlSyntax/Ast/UsingClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/ValuesClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/VerbalExprBinOp.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WhenClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WhenClauseList.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WhereClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WhereOrCurrentClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WindowClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WindowDefinition.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WindowExclusionClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WindowSpecification.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WithClause.hs +1/−1
- library-internal/PostgresqlSyntax/Ast/WithClause.hs-boot +1/−1
- library-internal/PostgresqlSyntax/Ast/Xconst.hs +1/−1
- library-internal/PostgresqlSyntax/Helpers/Parsers.hs +15/−7
- library-internal/PostgresqlSyntax/IsAst.hs +0/−44
- library-internal/PostgresqlSyntax/Prelude.hs +1/−1
- library-internal/PostgresqlSyntax/Settings.hs +2/−4
- library/PostgresqlSyntax.hs +6/−6
- nesting-bench/Main.hs +1/−1
- postgresql-syntax.cabal +2/−4
CHANGELOG.md view
@@ -1,3 +1,16 @@+# v0.5.0.2++## Non-breaking++- `PostgresqlSyntax.Algebra`'s `LeftRecursion base ext item` class (internal-library-only, not part of the public `PostgresqlSyntax` API) is now a single-method `Extends base ext` — drops the unread `item` type parameter: `extension`/`applyExtension`/`foldExtensions` are gone in favor of one `parseExtensions` method; `nonRecursiveParser` → `parseBase`; `parseLeftRecursive` → `parseMaybeExtended`; `leftRecursionProperties` → `extendedByProperties`. `JoinedTableExtension` is deleted (#33).+- `TableRef.hs` and `FuncApplicationParams.hs` now have explicit export lists, exporting only their types and instances (#30).++## Fixes++- Fixed the parsed tree shape of `UNION`/`INTERSECT`/`EXCEPT` chains to match Postgres's actual associativity and precedence (`gram.y`'s `%left UNION EXCEPT` / `%left INTERSECT`, INTERSECT binding tighter): `a EXCEPT b EXCEPT c` now nests left instead of right, and `a INTERSECT b UNION c` now roots at `UNION` instead of `INTERSECT`. Rendered text is unaffected; only `SimpleSelect`'s parsed/canonical tree shape for such chains changes (#30).+- Fixed a further associativity bug in the same fold: a run of two or more consecutive `INTERSECT`s (e.g. `a INTERSECT b INTERSECT c`) nested right instead of left, contradicting `gram.y`'s `%left INTERSECT`. Parsed/canonical tree shape changes for such chains; rendered text is unaffected (#34).+- Fixed `InsertRest` misparsing parenthesized `VALUES`/`SELECT` as a column list (#35).+ # v0.5.0.1 ## Fixes
bench/Main.hs view
@@ -24,9 +24,9 @@ import qualified Data.Text as Text import HeadedMegaparsec (HeadedParsec, parse, toParsec) import qualified PostgresqlSyntax+import Prelude import qualified Test.QuickCheck as Qc import qualified Text.Megaparsec as Megaparsec-import Prelude -- * Shared token scanner (mirrors 'PostgresqlSyntax.Helpers.Parsers.anyKeyword')
hspec-test/Ast/AExprSpec.hs view
@@ -2,18 +2,21 @@ import qualified Data.Text as Text import Helpers.Specs+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AExpr import PostgresqlSyntax.Ast.CExpr import PostgresqlSyntax.Ast.Columnref import PostgresqlSyntax.Ast.Ident+import PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens) import PostgresqlSyntax.Ast.VerbalExprBinOp-import PostgresqlSyntax.IsAst-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do itSatisfiesIsAst @AExpr+ itSatisfiesCanonicalizes @AExpr+ itSatisfiesRefines @SelectWithParens @AExpr itSatisfiesArbitrary @AExpr describe "Postgres grammar conformance" $ do -- gram.y:15985,15987 have only @a_expr qual_Op a_expr@ and
hspec-test/Ast/CExprSpec.hs view
@@ -7,4 +7,5 @@ spec :: Spec spec = do itSatisfiesIsAst @CExpr+ itSatisfiesCanonicalizes @CExpr itSatisfiesArbitrary @CExpr
hspec-test/Ast/DeleteStmtSpec.hs view
@@ -8,3 +8,6 @@ spec = do itSatisfiesIsAst @DeleteStmt itSatisfiesArbitrary @DeleteStmt+ itParses @DeleteStmt "delete from foo as set"+ itParses @DeleteStmt "delete from foo alias where 1"+ itRejects @DeleteStmt "delete from foo set"
hspec-test/Ast/FrameBoundSpec.hs view
@@ -1,10 +1,10 @@ module Ast.FrameBoundSpec (spec) where import Helpers.Specs+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FrameBound-import PostgresqlSyntax.IsAst-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do
hspec-test/Ast/InExprSpec.hs view
@@ -7,4 +7,5 @@ spec :: Spec spec = do itSatisfiesIsAst @InExpr+ itSatisfiesCanonicalizes @InExpr itSatisfiesArbitrary @InExpr
hspec-test/Ast/IndexElemSpec.hs view
@@ -1,10 +1,10 @@ module Ast.IndexElemSpec (spec) where import Helpers.Specs+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.IndexElem-import PostgresqlSyntax.IsAst-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do
hspec-test/Ast/InsertRestSpec.hs view
@@ -8,3 +8,7 @@ spec = do itSatisfiesIsAst @InsertRest itSatisfiesArbitrary @InsertRest+ -- https://github.com/nikita-volkov/postgresql-syntax/issues/35+ itParses @InsertRest "(values (default))"+ itParses @InsertRest "(select 1)"+ itParses @InsertRest "(values) values (1)"
hspec-test/Ast/InsertStmtSpec.hs view
@@ -8,3 +8,5 @@ spec = do itSatisfiesIsAst @InsertStmt itSatisfiesArbitrary @InsertStmt+ -- https://github.com/nikita-volkov/postgresql-syntax/issues/35+ itParses @InsertStmt "insert into ta.xa (values (default))"
− hspec-test/Ast/JoinMethSpec.hs
@@ -1,10 +0,0 @@-module Ast.JoinMethSpec (spec) where--import Helpers.Specs-import PostgresqlSyntax.Ast.JoinMeth-import Test.Hspec--spec :: Spec-spec = do- itSatisfiesIsAst @JoinMeth- itSatisfiesArbitrary @JoinMeth
hspec-test/Ast/OpSpec.hs view
@@ -2,8 +2,8 @@ import Helpers.Specs import PostgresqlSyntax.Ast.Op-import Test.Hspec import Prelude hiding (Op)+import Test.Hspec spec :: Spec spec = do
hspec-test/Ast/PreparableStmtSpec.hs view
@@ -3,8 +3,8 @@ import qualified Data.Text as Text import Helpers.Specs import PostgresqlSyntax.Ast.PreparableStmt-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do
hspec-test/Ast/SconstSpec.hs view
@@ -2,8 +2,8 @@ import Helpers.Specs import PostgresqlSyntax.Ast.Sconst-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do
hspec-test/Ast/SelectClauseSpec.hs view
@@ -2,9 +2,11 @@ import Helpers.Specs import PostgresqlSyntax.Ast.SelectClause+import PostgresqlSyntax.Ast.SimpleSelect import Test.Hspec spec :: Spec spec = do itSatisfiesIsAst @SelectClause+ itSatisfiesExtends @SelectClause @SimpleSelect itSatisfiesArbitrary @SelectClause
hspec-test/Ast/SelectNoParensSpec.hs view
@@ -2,9 +2,11 @@ import Helpers.Specs import PostgresqlSyntax.Ast.SelectNoParens+import PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens) import Test.Hspec spec :: Spec spec = do itSatisfiesIsAst @SelectNoParens+ itSatisfiesRefines @SelectWithParens @SelectNoParens itSatisfiesArbitrary @SelectNoParens
hspec-test/Ast/SelectWithParensSpec.hs view
@@ -1,15 +1,16 @@ module Ast.SelectWithParensSpec (spec) where import Helpers.Specs+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.SelectNoParens import PostgresqlSyntax.Ast.SelectWithParens-import PostgresqlSyntax.IsAst-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do itSatisfiesIsAst @SelectWithParens+ itSatisfiesCanonicalizes @SelectWithParens itSatisfiesArbitrary @SelectWithParens describe "Nesting depth" $ do -- The parenthesised sub-select has two possible representations.
hspec-test/Ast/SimpleSelectSpec.hs view
@@ -1,10 +1,46 @@ module Ast.SimpleSelectSpec (spec) where import Helpers.Specs+import PostgresqlSyntax.Algebra+import PostgresqlSyntax.Ast.Ident+import PostgresqlSyntax.Ast.QualifiedName+import PostgresqlSyntax.Ast.RelationExpr+import PostgresqlSyntax.Ast.SelectBinOp+import PostgresqlSyntax.Ast.SelectClause import PostgresqlSyntax.Ast.SimpleSelect+import Prelude import Test.Hspec spec :: Spec spec = do itSatisfiesIsAst @SimpleSelect+ itSatisfiesCanonicalizes @SimpleSelect itSatisfiesArbitrary @SimpleSelect+ describe "Precedence" precedenceSpec++-- |+-- Reproduces the three parse-shape checks from+-- <https://github.com/nikita-volkov/postgresql-syntax/issues/30> against+-- @gram.y@'s @%left UNION EXCEPT@ \/ @%left INTERSECT@ declarations+-- (gram.y:813-814): @INTERSECT@ binds tighter than @UNION@\/@EXCEPT@, and+-- all three are left-associative among themselves.+precedenceSpec :: Spec+precedenceSpec = do+ it "a EXCEPT b EXCEPT c nests left"+ $ parse mempty "TABLE a EXCEPT TABLE b EXCEPT TABLE c"+ `shouldBe` Right (bin ExceptSelectBinOp (bin ExceptSelectBinOp (table "a") (table "b")) (table "c"))+ it "a INTERSECT b UNION c roots at UNION"+ $ parse mempty "TABLE a INTERSECT TABLE b UNION TABLE c"+ `shouldBe` Right (bin UnionSelectBinOp (bin IntersectSelectBinOp (table "a") (table "b")) (table "c"))+ it "a UNION b INTERSECT c is a UNION (b INTERSECT c)"+ $ parse mempty "TABLE a UNION TABLE b INTERSECT TABLE c"+ `shouldBe` Right (bin UnionSelectBinOp (table "a") (bin IntersectSelectBinOp (table "b") (table "c")))+ it "a INTERSECT b INTERSECT c nests left, not right (issue #34)"+ $ parse mempty "TABLE a INTERSECT TABLE b INTERSECT TABLE c"+ `shouldBe` Right (bin IntersectSelectBinOp (bin IntersectSelectBinOp (table "a") (table "b")) (table "c"))+ it "a INTERSECT b INTERSECT c INTERSECT d nests fully left (issue #34)"+ $ parse mempty "TABLE a INTERSECT TABLE b INTERSECT TABLE c INTERSECT TABLE d"+ `shouldBe` Right (bin IntersectSelectBinOp (bin IntersectSelectBinOp (bin IntersectSelectBinOp (table "a") (table "b")) (table "c")) (table "d"))+ where+ table name = TableSimpleSelect (SimpleRelationExpr (SimpleQualifiedName (UnquotedIdent name)) False)+ bin op lhs rhs = BinSimpleSelect op (SimpleSelectSelectClause lhs) Nothing (SimpleSelectSelectClause rhs)
hspec-test/Ast/SortBySpec.hs view
@@ -1,10 +1,10 @@ module Ast.SortBySpec (spec) where import Helpers.Specs+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.SortBy-import PostgresqlSyntax.IsAst-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do@@ -19,6 +19,4 @@ fmap render (parse @SortBy mempty "a desc nulls last") `shouldBe` Right "a DESC NULLS LAST" fmap render (parse @SortBy mempty "a nulls first") `shouldBe` Right "a NULLS FIRST" fmap render (parse @SortBy mempty "a using > nulls last") `shouldBe` Right "a USING > NULLS LAST"- case parse @SortBy mempty "nulls" of- Left _ -> pure ()- Right _ -> expectationFailure "expected a parse failure for bare \"nulls\""+ fmap render (parse @SortBy mempty "nulls") `shouldBe` Right "nulls"
hspec-test/Ast/TableRefSpec.hs view
@@ -1,10 +1,12 @@ module Ast.TableRefSpec (spec) where import Helpers.Specs+import PostgresqlSyntax.Ast.JoinedTable import PostgresqlSyntax.Ast.TableRef import Test.Hspec spec :: Spec spec = do itSatisfiesIsAst @TableRef+ itSatisfiesExtends @TableRef @JoinedTable itSatisfiesArbitrary @TableRef
hspec-test/Ast/TypenameSpec.hs view
@@ -3,8 +3,8 @@ import Helpers.Specs import PostgresqlSyntax.Ast.Typename import PostgresqlSyntax.Settings (nullabilityMarkers)-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do
hspec-test/Ast/UpdateStmtSpec.hs view
@@ -8,3 +8,5 @@ spec = do itSatisfiesIsAst @UpdateStmt itSatisfiesArbitrary @UpdateStmt+ itParses @UpdateStmt "update foo as set set x = 1"+ itRejects @UpdateStmt "update foo set set x = 1"
hspec-test/Ast/WindowSpecificationSpec.hs view
@@ -2,8 +2,8 @@ import Helpers.Specs import PostgresqlSyntax.Ast.WindowSpecification-import Test.Hspec import Prelude+import Test.Hspec spec :: Spec spec = do
hspec-test/Helpers/Expectations.hs view
@@ -13,11 +13,11 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text as Text-import PostgresqlSyntax.IsAst+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Settings (Settings)+import Prelude import Test.Hspec import Text.Megaparsec.Pos (sourcePosPretty)-import Prelude parsesTo :: forall a. (HasCallStack, IsAst a) => Text -> Expectation parsesTo input =
hspec-test/Helpers/Specs.hs view
@@ -2,6 +2,9 @@ module Helpers.Specs ( itSatisfiesIsAst,+ itSatisfiesCanonicalizes,+ itSatisfiesRefines,+ itSatisfiesExtends, itSatisfiesArbitrary, itParses, itRejects,@@ -17,27 +20,29 @@ import qualified Data.Text as Text import qualified Helpers.Expectations as Expectations-import PostgresqlSyntax.IsAst+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Settings (Settings)+import Prelude import Test.Hspec import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (counterexample, (===)) import qualified Test.QuickCheck as Qc-import Prelude itSatisfiesIsAst :: forall a. (IsAst a, Eq a, Show a, Qc.Arbitrary a) => Spec itSatisfiesIsAst =- describe "IsAst" $ do- prop "Roundtrips" $ \(a :: a) ->- let sql = toText mempty a- in case parse mempty sql of- Left err ->- counterexample ("rendered: " <> Text.unpack sql <> "\nparse failed: " <> Text.unpack err) False- Right a' ->- counterexample- ("rendered: " <> Text.unpack sql <> "\nrestored: " <> Text.unpack (toText mempty a'))- (a' === a)+ describe "IsAst" $ for_ (isAstProperties @a) (uncurry prop) +itSatisfiesCanonicalizes :: forall a. (Canonicalizes a, Eq a, Show a, Qc.Arbitrary a) => Spec+itSatisfiesCanonicalizes =+ describe "Canonicalizes" $ for_ (canonicalizesProperties @a) (uncurry prop)++itSatisfiesRefines :: forall sub sup. (Refines sub sup, IsAst sub, Eq sub, Show sub, Qc.Arbitrary sub) => Spec+itSatisfiesRefines =+ describe "Refines" $ for_ (refinesProperties @sub @sup) (uncurry prop)++itSatisfiesExtends :: forall base ext. (Extends base ext, IsAst base, Eq base, Show base, Qc.Arbitrary base) => Spec+itSatisfiesExtends =+ describe "Extends" $ for_ (extendedByProperties @base @ext) (uncurry prop)+ itSatisfiesArbitrary :: forall a. (IsAst a, Show a, Qc.Arbitrary a) => Spec itSatisfiesArbitrary = describe "Arbitrary" $ do@@ -80,7 +85,7 @@ describe (Text.unpack sql) $ do it ("Reports error: " <> expected) (Expectations.reportsError @a sql expected) --- | Like 'itReportsError' but checks 'PostgresqlSyntax.IsAst.parseWithSourcePosError''s+-- | Like 'itReportsError' but checks 'PostgresqlSyntax.Algebra.parseWithSourcePosError''s -- 'Text.Megaparsec.SourcePos'-based errors instead. itReportsSourcePosError :: forall a. (HasCallStack, IsAst a) => Text -> String -> Spec itReportsSourcePosError sql expected =
hspec-test/Main.hs view
@@ -1,8 +1,8 @@ module Main (main) where +import Prelude import qualified Spec import Test.Hspec-import Prelude main :: IO () main = hspec $ parallel Spec.spec
+ library-internal/PostgresqlSyntax/Algebra.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module PostgresqlSyntax.Algebra+ ( IsAst (..),+ toText,+ parse,+ parseWithPosError,+ parseWithSourcePosError,+ isAstProperties,+ Canonicalizes (..),+ canonicalizesProperties,+ Refines (..),+ refinesProperties,+ LeftRecursive (..),+ Extends (..),+ extendedByProperties,+ parseMaybeExtended,+ parseExtended,+ parseExtensionChain,+ )+where++import qualified Data.Text as Text+import qualified HeadedMegaparsec as Parser+import qualified PostgresqlSyntax.Extras.HeadedMegaparsec as Extras+import PostgresqlSyntax.Prelude+import PostgresqlSyntax.Settings (Settings)+import qualified Test.QuickCheck as Qc+import qualified Text.Megaparsec as Megaparsec+import qualified TextBuilder++-- |+-- Class of AST types that can be rendered to SQL text and parsed back again.+--+-- Laws:+--+-- * __Roundtrips__: @parse settings (toText settings a) = Right a@ for every+-- 'Settings' — rendering and parsing are inverses.+-- * __Congruent rendering__: @a == b => toTextBuilder settings a == toTextBuilder settings b@+-- for every 'Settings' — rendering only depends on the value, not on how it+-- was constructed. This is what makes it meaningful to say two structurally+-- different shapes can still render to identical text — the ambiguity that+-- 'Canonicalizes' exists to resolve.+class IsAst a where+ -- |+ -- Render an AST value to a 'TextBuilder' using the given 'Settings'.+ -- This is the low-level rendering primitive; 'toText' wraps it.+ toTextBuilder :: Settings -> a -> TextBuilder++ -- |+ -- A parser for this AST type, parameterized by 'Settings'.+ -- The parser must satisfy the roundtrip law documented on 'IsAst'.+ parser :: Settings -> Parser a++-- |+-- 'Qc.Property'-checkers for 'IsAst'\'s documented laws, keyed by name.+isAstProperties :: forall a. (IsAst a, Eq a, Show a, Qc.Arbitrary a) => [(String, Qc.Property)]+isAstProperties =+ [ ( "Roundtrips",+ Qc.property $ \(a :: a) ->+ let sql = toText mempty a+ in case parse mempty sql of+ Left err ->+ Qc.counterexample ("rendered: " <> Text.unpack sql <> "\nparse failed: " <> Text.unpack err) False+ Right a' ->+ Qc.counterexample+ ("rendered: " <> Text.unpack sql <> "\nrestored: " <> Text.unpack (toText mempty a'))+ (a' Qc.=== a)+ ),+ ( "Renders equal values equally",+ Qc.property $ \(a :: a) (b :: a) ->+ a /= b || toText mempty a == toText mempty b+ )+ ]++-- |+-- Render a value to 'Text' via its 'toTextBuilder' method.+toText :: (IsAst a) => Settings -> a -> Text+toText settings = TextBuilder.toText . toTextBuilder settings++-- |+-- Parse a 'Text' input with the type's 'parser', returning either a+-- pretty-printed error or the parsed value. The parser is chosen by the+-- caller's type inference (via the 'IsAst' constraint), so callers no longer+-- pass an explicit parser argument.+parse :: (IsAst a) => Settings -> Text -> Either Text a+parse settings = first Text.pack . Extras.run (Extras.totally (parser settings))++-- |+-- Like 'parse' but returns the structured error list (each error paired with+-- its byte offset) instead of a single pretty-printed message.+parseWithPosError :: (IsAst a) => Settings -> Text -> Either (NonEmpty (Int, Text)) a+parseWithPosError settings = first (fmap (second Text.pack)) . Extras.runParserWithErrorPos (Extras.totally (parser settings))++-- |+-- Like 'parseWithPosError' but pairs each error with its+-- 'Text.Megaparsec.SourcePos' instead of a raw byte offset.+parseWithSourcePosError :: (IsAst a) => Settings -> Text -> Either (NonEmpty (Megaparsec.SourcePos, Text)) a+parseWithSourcePosError settings = first (fmap (second Text.pack)) . Extras.runParserWithSourcePosError (Extras.totally (parser settings))++-- |+-- Laws:+--+-- * __Idempotent__: @canonicalize . canonicalize = canonicalize@+-- * __Parse-agreement__ (the property this class exists to provide):+-- @parse settings . toText settings = Right . canonicalize@ for every+-- 'PostgresqlSyntax.Settings.Settings'+class (IsAst a) => Canonicalizes a where+ canonicalize :: a -> a+ canonicalize = id++-- |+-- 'Qc.Property'-checkers for 'Canonicalizes'\'s documented laws, keyed by+-- name. \"Parse-agreement\" is tested at 'mempty' 'Settings', matching how+-- 'isAstProperties'\'s \"Renders equal values equally\" property handles \"for+-- every 'Settings'\" — no 'Qc.Arbitrary' 'Settings' instance exists or is+-- being added.+canonicalizesProperties :: forall a. (Canonicalizes a, Eq a, Show a, Qc.Arbitrary a) => [(String, Qc.Property)]+canonicalizesProperties =+ [ ( "Idempotent",+ Qc.property $ \(a :: a) ->+ canonicalize (canonicalize a) Qc.=== canonicalize a+ ),+ ( "Parse-agreement",+ Qc.property $ \(a :: a) ->+ parse mempty (toText mempty a) Qc.=== Right (canonicalize a)+ )+ ]++-- |+-- Laws:+--+-- * __Refinement law__: @project . embed = Just@+--+-- Expresses embedding relationships between AST node types across module+-- boundaries where cross-module pattern matching is unavailable. Instances+-- hold between two types when the 'sub' type can be trivially embedded into+-- 'sup', and trivial 'sup' values can be recognized as such a 'sub' and+-- extracted back out.+class Refines sub sup where+ embed :: sub -> sup+ project :: sup -> Maybe sub++-- |+-- 'Qc.Property'-checkers for 'Refines'\'s documented laws, keyed by name.+refinesProperties :: forall sub sup. (Refines sub sup, IsAst sub, Eq sub, Show sub, Qc.Arbitrary sub) => [(String, Qc.Property)]+refinesProperties =+ [ ( "Refinement law",+ Qc.property $ \(a :: sub) ->+ project (embed a :: sup) Qc.=== Just a+ )+ ]++-- |+-- A type some of whose grammar productions are left-recursive — i.e. there+-- is a larger recursive form built by extending a value of this type on its+-- left. 'parseBase' is everything that is /not/ one of those productions:+-- the @β@ of @A -> Aα | β@.+--+-- This is a strictly weaker claim than 'Extends', which additionally+-- names the specific @ext@ of one such hub. A type can be 'LeftRecursive'+-- without being any hub's @base@ — 'PostgresqlSyntax.Ast.JoinedTable' and+-- 'PostgresqlSyntax.Ast.SimpleSelect' both are, since each is reached by+-- extending a /different/ type (@table_ref@ and @select_clause@+-- respectively) yet still has non-left-recursive productions of its own.+--+-- Separating this from 'Extends' is what lets each instance live with+-- the type it constructs: 'parseBase' mentions only its own type, so it+-- belongs to that type's module, while a hub's 'parseExtensions' belongs to+-- the module defining @ext@. Because both are class methods, either module+-- can reach the other's parser through an @hs-boot@ instance declaration+-- without exporting a bare helper.+--+-- Note that \"non-recursive\" here means non-/left/-recursive only: a+-- production may still recurse, so long as it doesn't begin with the+-- recursive position (e.g. @'(' joined_table ')'@).+class (IsAst a) => LeftRecursive a where+ -- | Parse only the productions that don't left-recurse (@β@).+ parseBase :: Settings -> Parser a++-- |+-- The two halves of a left-recursive grammar production, split apart by+-- left-recursion elimination (@A -> Aα | β@ becomes @A -> β α*@): 'base' is+-- @A@ (and supplies @β@ via its 'LeftRecursive' instance), and 'ext' is+-- what one or more @α@\'s, applied to a @base@, produce.+--+-- Laws:+--+-- * __Base-parser agreement__: @parser \@base = parseMaybeExtended \@base@+-- * __Maximal munch__: 'parseExtensions' must not return while a further+-- extension is available — instances build this on 'parseExtensionChain'+-- where possible, which already guarantees it.+class (LeftRecursive base, Refines ext base) => Extends base ext | ext -> base where+ -- | Parse one or more extensions onto an already-parsed left operand,+ -- folding as it goes, and return the fully-extended result.+ parseExtensions :: Settings -> base -> Parser ext++-- |+-- 'Qc.Property'-checker for 'Extends'\'s \"Base-parser agreement\" law,+-- keyed by name. \"Maximal munch\" isn't checked here: it's a per-instance+-- parsing obligation, not something a generated 'base' value can exercise+-- through 'parser' alone. The agreement check is itself up to whether+-- parsing succeeds, ignoring error message text, since a base's 'parser'+-- may wrap 'parseMaybeExtended' in a 'HeadedMegaparsec.label' or similar+-- that changes failure messages without changing what's accepted.+extendedByProperties :: forall base ext. (Extends base ext, IsAst base, Eq base, Show base, Qc.Arbitrary base) => [(String, Qc.Property)]+extendedByProperties =+ [ ( "Base-parser agreement",+ Qc.property $ \(a :: base) ->+ let sql = toText mempty a+ run p = first (const ()) (Extras.run (Extras.totally p) sql)+ in run (parser @base mempty) Qc.=== run (parseMaybeExtended @ext mempty)+ )+ ]++-- |+-- Parses zero or more extensions onto a 'parseBase', via 'parseExtensions'.+-- This is what @A -> β α*@ (the whole of @A@) means as a parser.+parseMaybeExtended :: forall ext base. (Extends base ext) => Settings -> Parser base+parseMaybeExtended settings = do+ b <- parseBase @base settings+ optional (parseExtensions @base settings b) >>= maybe (pure b) (pure . embed @ext @base)++-- |+-- Like 'parseMaybeExtended', but requires at least one extension to follow+-- the base, and so returns the fully-applied 'ext' type directly rather+-- than 'base'. This is what a bare @α*@ (one or more) means as a parser,+-- for hubs where a chain of at least one extension is itself the+-- interesting type (e.g. a @joined_table@, which is never a bare+-- @table_ref@ with zero joins).+--+-- Unlike 'parseMaybeExtended', 'parseBase' here is wrapped in+-- 'Parser.wrapToHead'. Without it, if 'parseBase' itself commits past an+-- internal 'Parser.endHead' (e.g. by matching a nested, fully-parenthesized+-- instance of the very thing this function's caller is one alternative+-- for), that commitment silently swallows the immediately-following "is+-- there at least one extension?" check: a missing extension would fail as+-- a hard, uncatchable error instead of a clean one this function's own+-- caller can backtrack from. 'wrapToHead' resets that, forcing the check+-- to fail cleanly. 'parseMaybeExtended' doesn't need this: its own+-- extension check already goes through 'optional', which independently+-- wraps in 'Megaparsec.try' regardless of what 'parseBase' committed to.+parseExtended :: forall base ext. (Extends base ext) => Settings -> Parser ext+parseExtended settings = do+ b <- Parser.wrapToHead (parseBase @base settings)+ parseExtensions @base settings b++-- |+-- Parses one or more items back-to-back, wrapping each in+-- 'Parser.wrapToHead'\/'Parser.endHead' so that, once an item's own head has+-- matched, backtracking out of the whole chain (back to "there are no more+-- items") is no longer attempted — matching the hand-written+-- recursive-descent loops this replaces. This is the shared backtracking+-- protocol underlying 'Extends'\'s \"Maximal munch\" law: an instance+-- building 'parseExtensions' on top of this combinator gets the law for+-- free, since 'go' only stops once a further item genuinely isn't+-- available.+parseExtensionChain :: Parser item -> Parser (NonEmpty item)+parseExtensionChain item = go+ where+ go = do+ i <- Parser.wrapToHead item+ Parser.endHead+ rest <- optional go+ pure $ case rest of+ Nothing -> i :| []+ Just (j :| js) -> i :| j : js
library-internal/PostgresqlSyntax/Ast.hs view
@@ -77,7 +77,6 @@ Interval (..), IntervalSecond (..), IntoClause (..),- JoinMeth (..), JoinQual (..), JoinType (..), JoinedTable (..),@@ -255,7 +254,6 @@ import PostgresqlSyntax.Ast.Interval import PostgresqlSyntax.Ast.IntervalSecond import PostgresqlSyntax.Ast.IntoClause-import PostgresqlSyntax.Ast.JoinMeth import PostgresqlSyntax.Ast.JoinQual import PostgresqlSyntax.Ast.JoinType import PostgresqlSyntax.Ast.JoinedTable
library-internal/PostgresqlSyntax/Ast/AExpr.hs view
@@ -1,20 +1,14 @@ module PostgresqlSyntax.Ast.AExpr ( AExpr (..),- filteredParser,- isBoundedAExprOperand,- safeAExprOperand,- selectWithParensAExpr,- refineToSelectWithParens,- canonicalize, ) where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AExprReversableOp-import PostgresqlSyntax.Ast.AnyName hiding (filteredParser)+import PostgresqlSyntax.Ast.AnyName import PostgresqlSyntax.Ast.CExpr (CExpr) import qualified PostgresqlSyntax.Ast.CExpr as CExpr-import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.QualOp import PostgresqlSyntax.Ast.Row import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens)@@ -26,7 +20,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import PostgresqlSyntax.Settings (Settings) import qualified Test.QuickCheck as Qc@@ -313,13 +306,6 @@ CExprAExpr (CExpr.ImplicitRowCExpr x) -> Just (ImplicitRowRow x) _ -> Nothing --- | 'parser', but rejecting the given words when they'd otherwise be--- accepted as a trailing bare column-reference identifier. Needed by--- "PostgresqlSyntax.Ast.SortBy", which must not let @a_expr@ swallow a--- Parsers.keyword (@USING@\/@ASC@\/@DESC@\/@NULLS@) that is meant to terminate it.-filteredParser :: Settings -> [Text] -> Parser AExpr-filteredParser settings excluded = customizedParser settings (CExpr.customizedParser settings (Parsers.filteredColIdLike UnquotedIdent (parser settings) excluded))- -- | -- Whether the given 'AExpr' is safe to place in the left\/accumulator -- position of a suffix production without parenthesizing it — see@@ -375,26 +361,11 @@ then a else CExprAExpr (CExpr.InParensCExpr a Nothing) --- |--- Smart constructor wrapping a bare 'SelectWithParens' as an 'AExpr', for--- modules that can only see 'AExpr' via its @hs-boot@ (which keeps it--- abstract to break an import cycle) — see "PostgresqlSyntax.Ast.InExpr",--- which needs it to canonicalize a @select_with_parens@\/@expr_list@--- ambiguity.-selectWithParensAExpr :: SelectWithParens -> AExpr-selectWithParensAExpr a = CExprAExpr (CExpr.SelectWithParensCExpr a Nothing)---- |--- If an 'AExpr' is a bare, indirection-less 'PostgresqlSyntax.Ast.CExpr.SelectWithParensCExpr'--- wrapping, returns the wrapped 'SelectWithParens'. The inverse of--- 'selectWithParensAExpr', exposed for the same @hs-boot@-abstraction reason--- — see "PostgresqlSyntax.Ast.CExpr", which needs it to canonicalize an--- @'(' a_expr ')'@\/@select_with_parens@ ambiguity analogous to the one--- described there.-refineToSelectWithParens :: AExpr -> Maybe SelectWithParens-refineToSelectWithParens = \case- CExprAExpr (CExpr.SelectWithParensCExpr a Nothing) -> Just a- _ -> Nothing+instance Refines SelectWithParens AExpr where+ embed a = CExprAExpr (CExpr.SelectWithParensCExpr a Nothing)+ project = \case+ CExprAExpr (CExpr.SelectWithParensCExpr a Nothing) -> Just a+ _ -> Nothing -- | -- Collapses the non-canonical @Right@-wrapping-a-bare-@select_with_parens@@@ -411,11 +382,11 @@ -- making the latter non-canonical for this shape. Both 'arbitrary' and -- 'shrink' can otherwise construct it, which renders fine but parses back to -- a different, canonical value and so breaks the roundtrip property.-canonicalize :: AExpr -> AExpr-canonicalize = \case- SubqueryAExpr a b c (Right d)- | Just inner <- refineToSelectWithParens d -> SubqueryAExpr a b c (Left inner)- other -> other+instance Canonicalizes AExpr where+ canonicalize = \case+ SubqueryAExpr a b c (Right d)+ | Just inner <- project d -> SubqueryAExpr a b c (Left inner)+ other -> other instance Qc.Arbitrary AExpr where shrink = fmap canonicalize . Qc.genericShrink
library-internal/PostgresqlSyntax/Ast/AExpr.hs-boot view
@@ -1,10 +1,9 @@ module PostgresqlSyntax.Ast.AExpr where +import PostgresqlSyntax.Algebra (IsAst, Refines)+import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens)-import PostgresqlSyntax.IsAst (IsAst)-import PostgresqlSyntax.Prelude (Bool, Data, Eq, Maybe, Ord, Parser, Show, Text)-import PostgresqlSyntax.Settings (Settings)-import Test.QuickCheck (Arbitrary, Gen)+import Test.QuickCheck (Arbitrary) data AExpr @@ -20,20 +19,4 @@ instance Arbitrary AExpr --- | 'parser', but rejecting the given words when they'd otherwise be--- accepted as a trailing bare column-reference identifier. Needed by--- "PostgresqlSyntax.Ast.SortBy", which must not let @a_expr@ swallow a--- keyword (@USING@\/@ASC@\/@DESC@\/@NULLS@) that is meant to terminate it.-filteredParser :: Settings -> [Text] -> Parser AExpr---- | See "PostgresqlSyntax.Ast.AExpr" for the full documentation.-isBoundedAExprOperand :: AExpr -> Bool---- | See "PostgresqlSyntax.Ast.AExpr" for the full documentation.-safeAExprOperand :: Gen AExpr -> Gen AExpr---- | See "PostgresqlSyntax.Ast.AExpr" for the full documentation.-selectWithParensAExpr :: SelectWithParens -> AExpr---- | See "PostgresqlSyntax.Ast.AExpr" for the full documentation.-refineToSelectWithParens :: AExpr -> Maybe SelectWithParens+instance Refines SelectWithParens AExpr
library-internal/PostgresqlSyntax/Ast/AExprReversableOp.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.AExprReversableOp where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import {-# SOURCE #-} PostgresqlSyntax.Ast.BExpr (BExpr) import PostgresqlSyntax.Ast.InExpr@@ -8,7 +9,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/AexprConst.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.AexprConst where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Bconst import PostgresqlSyntax.Ast.ConstTypename import PostgresqlSyntax.Ast.Fconst@@ -13,7 +14,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc import qualified Text.Megaparsec as Megaparsec
library-internal/PostgresqlSyntax/Ast/AliasClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.AliasClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.NameList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/AllOp.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.AllOp where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.MathOp import PostgresqlSyntax.Ast.Op-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/AnyName.hs view
@@ -1,13 +1,12 @@ module PostgresqlSyntax.Ast.AnyName where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Attrs import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude-import PostgresqlSyntax.Settings (Settings) import qualified Test.QuickCheck as Qc -- |@@ -42,10 +41,3 @@ instance Qc.Arbitrary AnyName where shrink = Qc.genericShrink arbitrary = AnyName <$> arbitrary <*> arbitrary---- | 'parser', but rejecting the given words when they'd otherwise be--- accepted as the leading identifier — needed by--- "PostgresqlSyntax.Ast.IndexElem"'s @opt_class@ position, mirroring the--- pre-extraction @filteredAnyName@.-filteredParser :: Settings -> [Text] -> Parser AnyName-filteredParser settings excluded = AnyName <$> (Parser.wrapToHead (Parsers.filteredColIdLike UnquotedIdent (parser settings) excluded) <* Parser.endHead) <*> optional (Parsers.space *> parser settings)
library-internal/PostgresqlSyntax/Ast/AnyOperator.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.AnyOperator where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AllOp import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ArrayBounds.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ArrayBounds where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Iconst import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ArrayExpr where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ArrayExprList import PostgresqlSyntax.Ast.ExprList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs-boot view
@@ -1,6 +1,6 @@ module PostgresqlSyntax.Ast.ArrayExpr where -import PostgresqlSyntax.IsAst (IsAst)+import PostgresqlSyntax.Algebra (IsAst) import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary)
library-internal/PostgresqlSyntax/Ast/ArrayExprList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ArrayExprList where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.ArrayExpr (ArrayExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/AscDesc.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.AscDesc where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Attrs.hs view
@@ -2,10 +2,10 @@ import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/BExpr.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.BExpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.BExprIsOp import PostgresqlSyntax.Ast.CExpr (CExpr) import PostgresqlSyntax.Ast.QualOp@@ -9,7 +10,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/BExpr.hs-boot view
@@ -1,6 +1,6 @@ module PostgresqlSyntax.Ast.BExpr where -import PostgresqlSyntax.IsAst (IsAst)+import PostgresqlSyntax.Algebra (IsAst) import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary)
library-internal/PostgresqlSyntax/Ast/BExprIsOp.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.BExprIsOp where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.BExpr (BExpr) import PostgresqlSyntax.Ast.TypeList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Bconst.hs view
@@ -2,9 +2,9 @@ import qualified Data.Text as Text import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.Shrinks as Shrinks-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc import qualified TextBuilder
library-internal/PostgresqlSyntax/Ast/Bit.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.Bit where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExprList import PostgresqlSyntax.Ast.OptVarying import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/CExpr.hs view
@@ -1,12 +1,11 @@ module PostgresqlSyntax.Ast.CExpr ( CExpr (..),- customizedParser,- canonicalize, ) where import qualified HeadedMegaparsec as Parser-import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr, refineToSelectWithParens)+import PostgresqlSyntax.Algebra+import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.AexprConst import PostgresqlSyntax.Ast.ArrayExpr import PostgresqlSyntax.Ast.CaseExpr@@ -17,13 +16,12 @@ import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.ImplicitRow import PostgresqlSyntax.Ast.Indirection-import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens, withParensSelectWithParens)+import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens) import qualified PostgresqlSyntax.Extras.NonEmpty as NonEmpty import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import PostgresqlSyntax.Settings (Settings) import qualified Test.QuickCheck as Qc@@ -182,9 +180,9 @@ -- otherwise construct it (shrinking the outer indirection to @Nothing@ is -- exactly how it arises), which renders fine but parses back to a -- different, canonical value and so breaks the roundtrip property.-canonicalize :: CExpr -> CExpr-canonicalize = \case- InParensCExpr a outerIndirection- | Just inner <- refineToSelectWithParens a ->- SelectWithParensCExpr (withParensSelectWithParens inner) outerIndirection- other -> other+instance Canonicalizes CExpr where+ canonicalize = \case+ InParensCExpr a outerIndirection+ | Just inner <- project @SelectWithParens a ->+ SelectWithParensCExpr (embed @SelectWithParens inner) outerIndirection+ other -> other
library-internal/PostgresqlSyntax/Ast/CallStmt.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.CallStmt where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FuncApplication import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/CaseExpr.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.CaseExpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.WhenClauseList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Character.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.Character where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.OptVarying import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Columnref.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.Columnref where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident (Ident, colId) import PostgresqlSyntax.Ast.Indirection import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/CommonTableExpr.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.CommonTableExpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.PreparableStmt import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ConfExpr.hs view
@@ -1,13 +1,13 @@ module PostgresqlSyntax.Ast.ConfExpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.IndexParams import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ConstCharacter.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.ConstCharacter where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Character import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ConstDatetime.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ConstDatetime where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Timezone import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ConstTypename.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ConstTypename where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Bit (Bit) import PostgresqlSyntax.Ast.ConstCharacter import PostgresqlSyntax.Ast.ConstDatetime import PostgresqlSyntax.Ast.Numeric-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/DeleteStmt.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.DeleteStmt where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.RelationExprOptAlias (RelationExprOptAlias)-import qualified PostgresqlSyntax.Ast.RelationExprOptAlias as RelationExprOptAlias import PostgresqlSyntax.Ast.ReturningClause import PostgresqlSyntax.Ast.UsingClause import PostgresqlSyntax.Ast.WhereOrCurrentClause@@ -10,7 +10,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc @@ -39,7 +38,7 @@ Parser.endHead Parsers.keyword "from" Parsers.space1- b <- RelationExprOptAlias.customizedParser settings ["using", "where", "returning"]+ b <- parser settings c <- optional (Parsers.space1 *> parser settings) d <- optional (Parsers.space1 *> parser settings) e <- optional (Parsers.space1 *> parser settings)
library-internal/PostgresqlSyntax/Ast/ExplicitRow.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.ExplicitRow where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExprList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ExprList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ExprList where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ExtractArg.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.ExtractArg where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.Sconst import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ExtractList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ExtractList where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.ExtractArg import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Fconst.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.Fconst where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ForLockingClause.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.ForLockingClause where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ForLockingItem import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ForLockingItem.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.ForLockingItem where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ForLockingStrength import PostgresqlSyntax.Ast.QualifiedName import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ForLockingStrength.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.ForLockingStrength where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FrameBound.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.FrameBound where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FrameClause.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.FrameClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FrameClauseMode import PostgresqlSyntax.Ast.FrameExtent import PostgresqlSyntax.Ast.WindowExclusionClause import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FrameClauseMode.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.FrameClauseMode where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FrameExtent.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.FrameExtent where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FrameBound import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FromClause.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.FromClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FromList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FromList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.FromList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.TableRef import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncAliasClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.FuncAliasClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AliasClause import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.TableFuncElementList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncApplication.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.FuncApplication where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FuncApplicationParams import PostgresqlSyntax.Ast.FuncName import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncApplicationParams.hs view
@@ -1,12 +1,15 @@-module PostgresqlSyntax.Ast.FuncApplicationParams where+module PostgresqlSyntax.Ast.FuncApplicationParams+ ( FuncApplicationParams (..),+ )+where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FuncArgExpr import PostgresqlSyntax.Ast.SortClause import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.Predicate as Predicate import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncArgExpr.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.FuncArgExpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncConstArgs.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.FuncConstArgs where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FuncArgExpr import PostgresqlSyntax.Ast.SortClause import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncExpr.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.FuncExpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.FuncApplication import PostgresqlSyntax.Ast.FuncExprCommonSubexpr@@ -9,7 +10,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.FuncExprCommonSubexpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.ExprList import PostgresqlSyntax.Ast.ExtractList@@ -14,7 +15,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs-boot view
@@ -1,6 +1,6 @@ module PostgresqlSyntax.Ast.FuncExprCommonSubexpr where -import PostgresqlSyntax.IsAst (IsAst)+import PostgresqlSyntax.Algebra (IsAst) import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary)
library-internal/PostgresqlSyntax/Ast/FuncExprWindowless.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.FuncExprWindowless where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FuncApplication import PostgresqlSyntax.Ast.FuncExprCommonSubexpr-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncName.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.FuncName where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.Indirection import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/FuncTable.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.FuncTable where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FuncExprWindowless import PostgresqlSyntax.Ast.OptOrdinality import PostgresqlSyntax.Ast.RowsfromList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/GenericType.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.GenericType where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Attrs import PostgresqlSyntax.Ast.ExprList import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/GroupByItem.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.GroupByItem where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.ExprList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/GroupClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.GroupClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.GroupByItem import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/HavingClause.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.HavingClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Iconst.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.Iconst where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Ident.hs view
@@ -2,10 +2,10 @@ import qualified Data.Text as Text import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.Shrinks as Shrinks-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import qualified PostgresqlSyntax.Predicate as Predicate import PostgresqlSyntax.Prelude hiding (filter, try)
library-internal/PostgresqlSyntax/Ast/ImplicitRow.hs view
@@ -1,13 +1,13 @@ module PostgresqlSyntax.Ast.ImplicitRow where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.ExprList import qualified PostgresqlSyntax.Extras.NonEmpty as NonEmpty import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/InExpr.hs view
@@ -4,13 +4,12 @@ where import qualified HeadedMegaparsec as Parser-import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (selectWithParensAExpr)+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExprList-import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens, refineToSelectWithParens)+import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc import qualified Text.Megaparsec as Megaparsec@@ -62,9 +61,9 @@ -- can otherwise construct the non-canonical shape, which renders fine but -- parses back to a different, canonical value and so breaks the -- roundtrip property.-canonicalize :: InExpr -> InExpr-canonicalize = \case- SelectInExpr a- | Just inner <- refineToSelectWithParens a ->- ExprListInExpr (ExprList (selectWithParensAExpr inner :| []))- other -> other+instance Canonicalizes InExpr where+ canonicalize = \case+ SelectInExpr a+ | Just inner <- project @SelectWithParens a ->+ ExprListInExpr (ExprList (embed @SelectWithParens inner :| []))+ other -> other
library-internal/PostgresqlSyntax/Ast/IndexElem.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.IndexElem where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AnyName import PostgresqlSyntax.Ast.AscDesc import PostgresqlSyntax.Ast.IndexElemDef@@ -8,7 +9,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc @@ -45,13 +45,7 @@ where collate = Parsers.keyword "collate" *> Parsers.space1 *> Parser.endHead *> parser settings - -- gram.y:8558 index_elem: ColId index_elem_options, and gram.y:8596- -- opt_nulls_order (index_elem_options inlines opt_qualified_name at- -- gram.y:8525 for the operator-class name). That name is a bare- -- ColId, so of the words that can terminate it only the unreserved- -- NULLS (kwlist.h:315) is a genuine hazard — ASC/DESC are reserved- -- (kwlist.h:47,138) and were never candidates.- class_ = filteredParser settings ["nulls"]+ class_ = parser settings instance Qc.Arbitrary IndexElem where shrink = Qc.genericShrink
library-internal/PostgresqlSyntax/Ast/IndexElemDef.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.IndexElemDef where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.FuncExprWindowless import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/IndexParams.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.IndexParams where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.IndexElem import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Indirection.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.Indirection where import Control.Applicative.Combinators.NonEmpty (some)+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.IndirectionEl import qualified PostgresqlSyntax.Helpers.Gens as Gens-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (some) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/IndirectionEl.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.IndirectionEl where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/InsertColumnItem.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.InsertColumnItem where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.Indirection import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/InsertColumnList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.InsertColumnList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.InsertColumnItem import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/InsertRest.hs view
@@ -1,13 +1,13 @@ module PostgresqlSyntax.Ast.InsertRest where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.InsertColumnList import PostgresqlSyntax.Ast.OverrideKind import PostgresqlSyntax.Ast.SelectStmt import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc @@ -41,7 +41,15 @@ asum [ DefaultValuesInsertRest <$ (Parsers.keyword "default" *> Parsers.space1 *> Parser.endHead *> Parsers.keyword "values"), do- a <- optional (Parsers.inParens (parser settings) <* Parsers.space1)+ -- 'Parser.wrapToHead' makes the whole parenthesized column list+ -- (including any 'Parser.endHead' calls inside 'InsertColumnItem')+ -- backtrackable as one unit. Without it, parsing e.g. @(VALUES ...)@+ -- would commit to treating @VALUES@ as a single-column+ -- 'InsertColumnList' entry (since it's a valid 'ColId') right after+ -- reading it, and fail instead of backtracking into the correct+ -- 'SelectStmt' (@select_with_parens@ wrapping a bare @VALUES@+ -- clause) parse below. See gram.y's @insert_rest@.+ a <- optional (Parser.wrapToHead (Parsers.inParens (parser settings) <* Parsers.space1)) b <- optional $ do Parsers.keyword "overriding" Parsers.space1
library-internal/PostgresqlSyntax/Ast/InsertStmt.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.InsertStmt where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.InsertRest import PostgresqlSyntax.Ast.InsertTarget import PostgresqlSyntax.Ast.OnConflict@@ -9,7 +10,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/InsertTarget.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.InsertTarget where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.QualifiedName import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Interval.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.Interval where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.IntervalSecond import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/IntervalSecond.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.IntervalSecond where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/IntoClause.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.IntoClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.OptTempTableName import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
− library-internal/PostgresqlSyntax/Ast/JoinMeth.hs
@@ -1,64 +0,0 @@-module PostgresqlSyntax.Ast.JoinMeth where--import PostgresqlSyntax.Ast.JoinQual-import PostgresqlSyntax.Ast.JoinType-import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst-import PostgresqlSyntax.Prelude-import qualified Test.QuickCheck as Qc---- |--- ==== References--- @--- | table_ref CROSS JOIN table_ref--- | table_ref join_type JOIN table_ref join_qual--- | table_ref JOIN table_ref join_qual--- | table_ref NATURAL join_type JOIN table_ref--- | table_ref NATURAL JOIN table_ref--- @------ In the concrete grammar, a 'JoinQual' is only ever written /after/ the--- second @table_ref@ — never contiguous with the rest of this type's own--- text. 'PostgresqlSyntax.Ast.TableRef' (the recursion hub this lives--- beside) therefore does its own hand-written interleaving of table refs--- and join methods rather than calling this instance; this one exists so--- 'JoinMeth' has a sensible, self-contained, round-trippable grammar in--- isolation (e.g. for 'Arbitrary'), not because anything threads through--- it.-data JoinMeth- = CrossJoinMeth- | QualJoinMeth (Maybe JoinType) JoinQual- | NaturalJoinMeth (Maybe JoinType)- deriving (Show, Generic, Eq, Ord, Data)--instance IsAst JoinMeth where- toTextBuilder settings = \case- CrossJoinMeth -> "CROSS JOIN"- QualJoinMeth a b -> TextBuilders.optLexemes [fmap (toTextBuilder settings) a, Just "JOIN", Just (toTextBuilder settings b)]- NaturalJoinMeth a -> TextBuilders.optLexemes [Just "NATURAL", fmap (toTextBuilder settings) a, Just "JOIN"]- parser settings =- asum- [ CrossJoinMeth <$ Parsers.keyphrase "cross join",- do- a <- optional (parser settings <* Parsers.space1)- Parsers.keyword "join"- Parsers.space1- b <- parser settings- return (QualJoinMeth a b),- do- Parsers.keyword "natural"- Parsers.space1- a <- optional (parser settings <* Parsers.space1)- Parsers.keyword "join"- return (NaturalJoinMeth a)- ]--instance Qc.Arbitrary JoinMeth where- shrink = Qc.genericShrink- arbitrary =- Qc.oneof- [ pure CrossJoinMeth,- QualJoinMeth <$> Qc.arbitrary <*> Qc.arbitrary,- NaturalJoinMeth <$> Qc.arbitrary- ]
library-internal/PostgresqlSyntax/Ast/JoinQual.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.JoinQual where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/JoinType.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.JoinType where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/JoinedTable.hs view
@@ -1,9 +1,18 @@-module PostgresqlSyntax.Ast.JoinedTable where+{-# OPTIONS_GHC -Wno-orphans #-} -import PostgresqlSyntax.Ast.JoinMeth-import {-# SOURCE #-} PostgresqlSyntax.Ast.TableRef (TableRef, joinedTableParser, renderJoinedTable)+module PostgresqlSyntax.Ast.JoinedTable+ ( JoinedTable (..),+ )+where++import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra+import PostgresqlSyntax.Ast.JoinQual+import PostgresqlSyntax.Ast.JoinType+import {-# SOURCE #-} PostgresqlSyntax.Ast.TableRef (TableRef) import qualified PostgresqlSyntax.Helpers.Gens as Gens-import PostgresqlSyntax.IsAst+import qualified PostgresqlSyntax.Helpers.Parsers as Parsers+import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc @@ -16,43 +25,117 @@ -- | table_ref JOIN table_ref join_qual -- | table_ref NATURAL join_type JOIN table_ref -- | table_ref NATURAL JOIN table_ref------ The options are covered by the `JoinMeth` type. -- @------ See 'PostgresqlSyntax.Ast.JoinMeth' for why this type's own 'IsAst'--- instance isn't what 'PostgresqlSyntax.Ast.TableRef' actually uses to--- parse\/render joined tables. data JoinedTable = InParensJoinedTable JoinedTable- | MethJoinedTable JoinMeth TableRef TableRef+ | CrossJoinedTable TableRef TableRef+ | QualJoinedTable TableRef (Maybe JoinType) TableRef JoinQual+ | NaturalJoinedTable TableRef (Maybe JoinType) TableRef deriving (Show, Generic, Eq, Ord, Data) -- |--- Delegates to 'PostgresqlSyntax.Ast.TableRef.renderJoinedTable'\/--- 'PostgresqlSyntax.Ast.TableRef.joinedTableParser' rather than combining--- 'TableRef'\'s and 'JoinMeth'\'s own instances directly: a bare @table_ref@--- parse is greedy — it absorbs any trailing @CROSS JOIN@\/@JOIN@\/@NATURAL--- JOIN@ continuation into itself (see 'PostgresqlSyntax.Ast.TableRef'\'s--- @recur@) — so parsing this type's own @b@ field with the plain exported--- 'PostgresqlSyntax.Ast.TableRef.parser' would always swallow the @a@\/@c@--- that's meant to follow it, and 'JoinMeth'\'s own renderer places a--- 'PostgresqlSyntax.Ast.JoinQual' immediately after the @JOIN@ keyword--- rather than after @c@ (see its own doc for why). 'TableRef' is the only--- module with both this type and 'TableRef' in scope non-abstractly at--- once, so it hosts the one correct, round-trippable implementation.+-- Parsing delegates to 'parseExtended' over the 'Extends' instance+-- below — a bare @table_ref@ parse is greedy, absorbing any trailing @CROSS+-- JOIN@\/@JOIN@\/@NATURAL JOIN@ continuation into itself, so a+-- @joined_table@ is never reachable as a bare, zero-extension 'TableRef';+-- it always needs at least one. Failing that, the only remaining+-- @joined_table@ production is the non-left-recursive 'parseBase'. instance IsAst JoinedTable where- toTextBuilder = renderJoinedTable- parser = joinedTableParser+ toTextBuilder settings = \case+ InParensJoinedTable a -> TextBuilders.renderInParens (toTextBuilder settings a)+ CrossJoinedTable a b -> toTextBuilder settings a <> " CROSS JOIN " <> toTextBuilder settings b+ QualJoinedTable a b c d -> toTextBuilder settings a <> TextBuilders.suffixMaybe (toTextBuilder settings) b <> " JOIN " <> toTextBuilder settings c <> " " <> toTextBuilder settings d+ NaturalJoinedTable a b c -> toTextBuilder settings a <> " NATURAL" <> TextBuilders.suffixMaybe (toTextBuilder settings) b <> " JOIN " <> toTextBuilder settings c + parser settings = parseExtended @TableRef settings <|> parseBase settings++-- |+-- The one @joined_table@ production that doesn't begin with a+-- left-recursive @table_ref@:+--+-- @+-- | '(' joined_table ')'+-- @+--+-- It still recurses — just not on the left, since the opening parenthesis+-- has to be consumed first. "PostgresqlSyntax.Ast.TableRef" reaches it+-- through this class method, which is why 'JoinedTable' needs no helper+-- export.+instance LeftRecursive JoinedTable where+ parseBase settings = InParensJoinedTable <$> Parsers.inParens (parser settings)+ instance Qc.Arbitrary JoinedTable where shrink = Qc.genericShrink arbitrary = Qc.sized $ \n -> if n <= 1- then MethJoinedTable <$> Qc.arbitrary <*> Gens.downscale Qc.arbitrary <*> Gens.downscale Qc.arbitrary- else- Qc.oneof- [ InParensJoinedTable <$> Gens.downscale Qc.arbitrary,- MethJoinedTable <$> Qc.arbitrary <*> Gens.downscale Qc.arbitrary <*> Gens.downscale Qc.arbitrary+ then joined+ else Qc.oneof [InParensJoinedTable <$> Gens.downscale Qc.arbitrary, joined]+ where+ joined =+ Qc.oneof+ [ CrossJoinedTable <$> Gens.downscale Qc.arbitrary <*> Gens.downscale Qc.arbitrary,+ QualJoinedTable <$> Gens.downscale Qc.arbitrary <*> Qc.arbitrary <*> Gens.downscale Qc.arbitrary <*> Qc.arbitrary,+ NaturalJoinedTable <$> Gens.downscale Qc.arbitrary <*> Qc.arbitrary <*> Gens.downscale Qc.arbitrary+ ]++-- |+-- The left-recursion-eliminated form of @table_ref@\/@joined_table@: a+-- 'TableRef' is the non-recursive base (@β@, its own 'parseBase'). All+-- three join kinds sit at the same precedence (@%left JOIN CROSS LEFT FULL+-- RIGHT INNER_P NATURAL@ in @gram.y@), and there's nothing to hold between+-- parsing a join and applying it, so no item type is warranted here —+-- unlike "PostgresqlSyntax.Ast.SimpleSelect", this hub isn't collect-then-fold.+instance Extends TableRef JoinedTable where+ -- ==== References+ -- @+ -- | table_ref CROSS JOIN table_ref+ -- | table_ref join_type JOIN table_ref join_qual+ -- | table_ref JOIN table_ref join_qual+ -- | table_ref NATURAL join_type JOIN table_ref+ -- | table_ref NATURAL JOIN table_ref+ -- @+ --+ -- Parses one join onto 'tr1', then recurses with the built 'JoinedTable'+ -- (embedded back to 'TableRef') as the new left operand, falling back to+ -- what's already built when no further join follows. The+ -- 'Parser.wrapToHead'\/'Parser.endHead' pair around the single join+ -- mirrors 'PostgresqlSyntax.Algebra.parseExtensionChain'\'s per-item+ -- protocol, since this recursive shape can't build on that combinator+ -- directly.+ parseExtensions settings tr1 = do+ built <- Parser.wrapToHead parseOneJoin+ Parser.endHead+ optional (parseExtensions @TableRef settings (embed built)) >>= pure . maybe built id+ where+ parseOneJoin =+ Parsers.space1+ *> asum+ [ do+ Parsers.keyphrase "cross join"+ Parser.endHead+ Parsers.space1+ tr2 <- parseBase @TableRef settings+ return (CrossJoinedTable tr1 tr2),+ do+ jt <- joinTypedJoin+ Parser.endHead+ Parsers.space1+ tr2 <- parser settings+ Parsers.space1+ jq <- parser settings+ return (QualJoinedTable tr1 jt tr2 jq),+ do+ Parsers.keyword "natural"+ Parser.endHead+ Parsers.space1+ jt <- joinTypedJoin+ Parsers.space1+ tr2 <- parseBase @TableRef settings+ return (NaturalJoinedTable tr1 jt tr2) ]+ joinTypedJoin =+ Just+ <$> (parser settings <* Parser.endHead <* Parsers.space1 <* Parsers.keyword "join")+ <|> Nothing+ <$ Parsers.keyword "join"
library-internal/PostgresqlSyntax/Ast/JoinedTable.hs-boot view
@@ -1,19 +1,3 @@ module PostgresqlSyntax.Ast.JoinedTable where -import PostgresqlSyntax.IsAst (IsAst)-import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show)-import Test.QuickCheck (Arbitrary)- data JoinedTable--instance Show JoinedTable--instance Eq JoinedTable--instance Ord JoinedTable--instance Data JoinedTable--instance IsAst JoinedTable--instance Arbitrary JoinedTable
library-internal/PostgresqlSyntax/Ast/LimitClause.hs view
@@ -1,13 +1,13 @@ module PostgresqlSyntax.Ast.LimitClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.SelectFetchFirstValue import PostgresqlSyntax.Ast.SelectLimitValue import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/MathOp.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.MathOp where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/NameList.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.NameList where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/NullsOrder.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.NullsOrder where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Numeric.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.Numeric where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExprList import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OffsetClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.OffsetClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.SelectFetchFirstValue import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OnConflict.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.OnConflict where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ConfExpr import PostgresqlSyntax.Ast.OnConflictDo import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OnConflictDo.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.OnConflictDo where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.SetClauseList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Op.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.Op where import qualified Data.Text as Text+import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.Shrinks as Shrinks-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.Predicate as Predicate import PostgresqlSyntax.Prelude import qualified PostgresqlSyntax.Validation as Validation
library-internal/PostgresqlSyntax/Ast/OptOrdinality.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.OptOrdinality where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OptTempTableName.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.OptTempTableName where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.QualifiedName import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OptVarying.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.OptVarying where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OverClause.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.OverClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.WindowSpecification import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OverlayList.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.OverlayList where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/OverrideKind.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.OverrideKind where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/PositionList.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.PositionList where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.BExpr (BExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/PreparableStmt.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.PreparableStmt where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.CallStmt import PostgresqlSyntax.Ast.DeleteStmt import PostgresqlSyntax.Ast.InsertStmt import PostgresqlSyntax.Ast.SelectStmt import PostgresqlSyntax.Ast.UpdateStmt-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/QualAllOp.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.QualAllOp where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AllOp import PostgresqlSyntax.Ast.AnyOperator import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/QualOp.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.QualOp where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AnyOperator import PostgresqlSyntax.Ast.Op import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/QualifiedName.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.QualifiedName where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.Indirection import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/RelationExpr.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.RelationExpr where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.QualifiedName import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/RelationExprOptAlias.hs view
@@ -1,16 +1,14 @@ module PostgresqlSyntax.Ast.RelationExprOptAlias ( RelationExprOptAlias (..),- customizedParser, ) where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.RelationExpr import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude-import PostgresqlSyntax.Settings (Settings) import qualified Test.QuickCheck as Qc -- |@@ -28,23 +26,17 @@ toTextBuilder settings (RelationExprOptAlias a b) = toTextBuilder settings a <> TextBuilders.suffixMaybe optAlias b where optAlias (c, d) = bool "" "AS " c <> toTextBuilder settings d- parser settings = customizedParser settings []---- |--- Parameterized over the alias identifier's excluded reserved words —--- callers like @update_stmt@\/@delete_stmt@ need to keep e.g. @SET@\/--- @USING@\/@WHERE@\/@RETURNING@ from being swallowed as a bare (unaliased)--- alias. Mirrors the pre-extraction @relationExprOptAlias@ taking a--- @reservedKeywords@ argument.-customizedParser :: Settings -> [Text] -> Parser RelationExprOptAlias-customizedParser settings reservedKeywords = do- a <- parser settings- b <- optional $ do- Parsers.space1- b <- Parsers.trueIfPresent (Parsers.keyword "as" *> Parsers.space1)- c <- Parsers.filteredColIdLike UnquotedIdent (parser settings) reservedKeywords- return (b, c)- return (RelationExprOptAlias a b)+ parser settings = do+ a <- parser settings+ b <- optional $ do+ Parsers.space1+ b <- Parsers.trueIfPresent (Parsers.keyword "as" *> Parsers.space1)+ -- Only the bare-alias (no @AS@) branch has the shift/reduce conflict+ -- that Postgres resolves by excluding @SET@; see @gram.y@, comment+ -- above @relation_expr_opt_alias@'s first production.+ c <- Parsers.filteredColIdLike UnquotedIdent (parser settings) (if b then [] else ["set"])+ return (b, c)+ return (RelationExprOptAlias a b) instance Qc.Arbitrary RelationExprOptAlias where shrink = Qc.genericShrink
library-internal/PostgresqlSyntax/Ast/ReturningClause.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.ReturningClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.TargetList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Row.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.Row where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExplicitRow import PostgresqlSyntax.Ast.ImplicitRow-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/RowsfromItem.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.RowsfromItem where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FuncExprWindowless import PostgresqlSyntax.Ast.TableFuncElementList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/RowsfromList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.RowsfromList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.RowsfromItem import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Sconst.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.Sconst where import qualified Data.Text as Text+import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.Shrinks as Shrinks-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc import qualified TextBuilder
library-internal/PostgresqlSyntax/Ast/SelectBinOp.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.SelectBinOp where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SelectClause.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.SelectClause where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens) import {-# SOURCE #-} PostgresqlSyntax.Ast.SimpleSelect (SimpleSelect) import qualified PostgresqlSyntax.Helpers.Gens as Gens-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc @@ -31,11 +31,39 @@ toTextBuilder settings = \case SimpleSelectSelectClause a -> toTextBuilder settings a WithParensSelectClause a -> toTextBuilder settings a- parser settings =- SimpleSelectSelectClause- <$> parser settings- <|> WithParensSelectClause- <$> parser settings++ -- ==== Law+ --+ -- @parser = parseMaybeExtended \@SelectClause@ — see+ -- 'PostgresqlSyntax.Ast.SimpleSelect'\'s 'PostgresqlSyntax.Algebra.Extends'+ -- instance for the real @select_clause@ grammar, including+ -- @UNION@\/@INTERSECT@\/@EXCEPT@-chaining.+ parser settings = parseMaybeExtended @SimpleSelect settings++-- |+-- Every @select_clause@ production except the left-recursive ones (those+-- are the @UNION@\/@INTERSECT@\/@EXCEPT@ continuations, hosted by+-- "PostgresqlSyntax.Ast.SimpleSelect"\'s+-- 'PostgresqlSyntax.Algebra.Extends' instance).+instance LeftRecursive SelectClause where+ parseBase settings =+ asum+ [ WithParensSelectClause <$> parser settings,+ SimpleSelectSelectClause <$> parseBase @SimpleSelect settings+ ]++-- |+-- A 'SimpleSelect' embeds trivially into a 'SelectClause' (it's one of its+-- two alternatives), and a 'SelectClause' of that exact shape is+-- recognizable back as one. Needed so+-- "PostgresqlSyntax.Ast.SimpleSelect"\'s+-- 'PostgresqlSyntax.Algebra.Extends' instance can fold a chain of+-- @UNION@\/@INTERSECT@\/@EXCEPT@ items onto a leading 'SelectClause'.+instance Refines SimpleSelect SelectClause where+ embed = SimpleSelectSelectClause+ project = \case+ SimpleSelectSelectClause a -> Just a+ _ -> Nothing instance Qc.Arbitrary SelectClause where shrink = Qc.genericShrink
library-internal/PostgresqlSyntax/Ast/SelectClause.hs-boot view
@@ -1,6 +1,6 @@ module PostgresqlSyntax.Ast.SelectClause where -import PostgresqlSyntax.IsAst (IsAst)+import PostgresqlSyntax.Algebra (IsAst) import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary)
library-internal/PostgresqlSyntax/Ast/SelectFetchFirstValue.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.SelectFetchFirstValue where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.CExpr import PostgresqlSyntax.Ast.Fconst import qualified PostgresqlSyntax.Extras.TextBuilder as TextBuilder import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SelectLimit.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.SelectLimit where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.LimitClause import PostgresqlSyntax.Ast.OffsetClause import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SelectLimitValue.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.SelectLimitValue where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs view
@@ -1,23 +1,20 @@ module PostgresqlSyntax.Ast.SelectNoParens ( SelectNoParens (..),- unparenthesizedSelectNoParensParser,- afterSelectWithParensClauseParser,- refineToSelectWithParens, ) where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ForLockingClause import PostgresqlSyntax.Ast.SelectClause import PostgresqlSyntax.Ast.SelectLimit import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens)-import {-# SOURCE #-} qualified PostgresqlSyntax.Ast.SimpleSelect as SimpleSelect+import {-# SOURCE #-} PostgresqlSyntax.Ast.SimpleSelect (SimpleSelect) import PostgresqlSyntax.Ast.SortClause import {-# SOURCE #-} PostgresqlSyntax.Ast.WithClause (WithClause) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import PostgresqlSyntax.Settings (Settings) import qualified Test.QuickCheck as Qc@@ -57,25 +54,14 @@ Parsers.space1 sharedSelectNoParens settings (Just with) -sharedSelectNoParens :: Settings -> Maybe WithClause -> Parser SelectNoParens-sharedSelectNoParens settings with = SimpleSelect.selectClauseBase settings >>= selectNoParensAfterClauseParser settings with- -- |--- 'PostgresqlSyntax.Ast.SelectNoParens.parser' restricted to the forms--- that do not begin with @(@ — see the boot-exposed signature's doc.-unparenthesizedSelectNoParensParser :: Settings -> Parser SelectNoParens-unparenthesizedSelectNoParensParser settings =- withSelectNoParens- <|> (SimpleSelect.baseSimpleSelect settings >>= selectNoParensAfterClauseParser settings Nothing . SimpleSelectSelectClause)- where- withSelectNoParens = do- with <- Parser.wrapToHead (parser settings)- Parsers.space1- sharedSelectNoParens settings (Just with)--selectNoParensAfterClauseParser :: Settings -> Maybe WithClause -> SelectClause -> Parser SelectNoParens-selectNoParensAfterClauseParser settings with clauseBase = do- select <- SimpleSelect.extendSelectClause settings clauseBase+-- Parses the @select_clause@ (see+-- 'PostgresqlSyntax.Ast.SimpleSelect'\'s 'Extends' instance for the+-- @UNION@\/@INTERSECT@\/@EXCEPT@-chaining grammar) plus everything that can+-- follow it.+sharedSelectNoParens :: Settings -> Maybe WithClause -> Parser SelectNoParens+sharedSelectNoParens settings with = do+ select <- parseMaybeExtended @SimpleSelect settings sort <- optional (Parsers.space1 *> parser settings) (limit, forLocking) <- limitFirst <|> forLockingFirst <|> pure (Nothing, Nothing) return (SelectNoParens with select sort limit forLocking)@@ -90,31 +76,18 @@ pure (limit, Just forLocking) -- |--- Parses the remainder of a @select_no_parens@ whose leading clause is--- already known to be a parenthesized select (@a@), then decides — per the--- \"Canonical shape\" rule — whether the result collapses back down to just--- that same parenthesized select (@Left@) or is a genuine--- @SelectNoParens@ wrapping it (@Right@). Needed by--- "PostgresqlSyntax.Ast.SelectWithParens", which can't pattern-match this--- module's own 'SelectNoParens' constructor across the hub boundary.-afterSelectWithParensClauseParser :: Settings -> SelectWithParens -> Parser (Either SelectWithParens SelectNoParens)-afterSelectWithParensClauseParser settings a = do- b <- selectNoParensAfterClauseParser settings Nothing (WithParensSelectClause a)- return $ case refineToSelectWithParens b of- Just c -> Left c- Nothing -> Right b---- | -- If a 'SelectNoParens' is merely a trivial wrapper around a single -- parenthesized select — no with-clause, sort, limit or locking clause of--- its own — returns the wrapped 'SelectWithParens'. Used by--- "PostgresqlSyntax.Ast.SelectWithParens" to canonicalize such wrappers--- into its @WithParensSelectWithParens@ shape — see its \"Canonical--- shape\" doc.+-- its own — returns the wrapped 'SelectWithParens'. Used by the+-- 'Refines' instance to canonicalize such wrappers. refineToSelectWithParens :: SelectNoParens -> Maybe SelectWithParens refineToSelectWithParens = \case SelectNoParens Nothing (WithParensSelectClause c) Nothing Nothing Nothing -> Just c _ -> Nothing++instance Refines SelectWithParens SelectNoParens where+ embed c = SelectNoParens Nothing (WithParensSelectClause c) Nothing Nothing Nothing+ project = refineToSelectWithParens instance Qc.Arbitrary SelectNoParens where shrink = Qc.genericShrink
library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs-boot view
@@ -1,9 +1,8 @@ module PostgresqlSyntax.Ast.SelectNoParens where import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens)-import PostgresqlSyntax.IsAst (IsAst)-import PostgresqlSyntax.Prelude (Data, Either, Eq, Maybe, Ord, Parser, Show)-import PostgresqlSyntax.Settings (Settings)+import PostgresqlSyntax.Algebra (IsAst, Refines)+import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary) data SelectNoParens@@ -20,8 +19,4 @@ instance Arbitrary SelectNoParens -unparenthesizedSelectNoParensParser :: Settings -> Parser SelectNoParens--afterSelectWithParensClauseParser :: Settings -> SelectWithParens -> Parser (Either SelectWithParens SelectNoParens)--refineToSelectWithParens :: SelectNoParens -> Maybe SelectWithParens+instance Refines SelectWithParens SelectNoParens
library-internal/PostgresqlSyntax/Ast/SelectStmt.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.SelectStmt where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectNoParens (SelectNoParens) import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens) import qualified PostgresqlSyntax.Helpers.Gens as Gens-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs view
@@ -1,17 +1,13 @@ module PostgresqlSyntax.Ast.SelectWithParens ( SelectWithParens (..),- refineToSelectWithParens,- withParensSelectWithParens, ) where -import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectNoParens (SelectNoParens)-import {-# SOURCE #-} qualified PostgresqlSyntax.Ast.SelectNoParens as SelectNoParens import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc @@ -33,31 +29,17 @@ NoParensSelectWithParens a -> toTextBuilder settings a WithParensSelectWithParens a -> toTextBuilder settings a - -- @gram.y@ gives two productions, @'(' select_with_parens ')'@ and- -- @'(' select_no_parens ')'@, and they overlap: a @select_no_parens@ may- -- itself be nothing but a @select_clause@, and a @select_clause@ may- -- itself be a @select_with_parens@. Transcribed literally as two- -- alternatives, that overlap makes every nested paren group get parsed- -- twice — once down the @select_with_parens@ branch and once down the- -- @select_no_parens@ branch — so the cost doubles with each level of- -- nesting. So the shared prefix is parsed once and classified afterwards.- -- -- ==== Canonical shape --- -- Because the productions overlap, @((select 1))@ has two- -- representations: @WithParensSelectWithParens@ wrapping the inner- -- parenthesised select, or @NoParensSelectWithParens@ of a- -- @SelectNoParens@ whose clause is that same inner parenthesised select.- -- Both render back to the same text. __The first is canonical.__- parser settings = Parsers.inParens selectWithParensBody- where- selectWithParensBody =- asum- [ do- a <- Parser.wrapToHead (parser settings)- either WithParensSelectWithParens NoParensSelectWithParens <$> SelectNoParens.afterSelectWithParensClauseParser settings a,- NoParensSelectWithParens <$> SelectNoParens.unparenthesizedSelectNoParensParser settings- ]+ -- Because @select_with_parens@ (@'(' select_with_parens ')'@) and+ -- @'(' select_no_parens ')'@ both parse @((select 1))@, there are two+ -- possible representations: @WithParensSelectWithParens@ wrapping the+ -- inner parenthesised select, or @NoParensSelectWithParens@ of a+ -- @SelectNoParens@ whose clause is that inner select. Both render back+ -- to the same text. __The first (@WithParensSelectWithParens@) is+ -- canonical.__ The 'Canonicalizes' instance normalizes shrunk or generated+ -- values to this shape.+ parser settings = Parsers.inParens (canonicalize . NoParensSelectWithParens <$> parser settings) instance Qc.Arbitrary SelectWithParens where shrink = fmap canonicalize . Qc.genericShrink@@ -75,29 +57,14 @@ -- the non-canonical shape (shrinking the inner 'SelectNoParens' toward -- @Nothing@s is exactly how it arises), which renders fine but parses back -- to a different, canonical value and so breaks the roundtrip property.-canonicalize :: SelectWithParens -> SelectWithParens-canonicalize = \case- NoParensSelectWithParens a- | Just c <- SelectNoParens.refineToSelectWithParens a -> WithParensSelectWithParens c- other -> other---- |--- If a 'SelectWithParens' is the @WithParensSelectWithParens@ wrapping of--- another one, returns the wrapped value. Exposed for modules that can--- only see 'SelectWithParens' via its @hs-boot@ (which keeps it abstract--- to break an import cycle) — see "PostgresqlSyntax.Ast.InExpr", which--- needs it to canonicalize a @select_with_parens@\/@expr_list@ ambiguity--- analogous to the one described above.-refineToSelectWithParens :: SelectWithParens -> Maybe SelectWithParens-refineToSelectWithParens = \case- WithParensSelectWithParens a -> Just a- _ -> Nothing+instance Canonicalizes SelectWithParens where+ canonicalize = \case+ NoParensSelectWithParens a+ | Just c <- project @SelectWithParens a -> WithParensSelectWithParens c+ other -> other --- |--- Smart constructor for the @WithParensSelectWithParens@ shape, for modules--- that can only see 'SelectWithParens' via its @hs-boot@ (which keeps it--- abstract to break an import cycle) — see "PostgresqlSyntax.Ast.CExpr",--- which needs it to canonicalize a @'(' a_expr ')'@\/@select_with_parens@--- ambiguity analogous to the one described above.-withParensSelectWithParens :: SelectWithParens -> SelectWithParens-withParensSelectWithParens = WithParensSelectWithParens+instance Refines SelectWithParens SelectWithParens where+ embed = WithParensSelectWithParens+ project = \case+ WithParensSelectWithParens a -> Just a+ _ -> Nothing
library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs-boot view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.SelectWithParens where -import PostgresqlSyntax.IsAst (IsAst)-import PostgresqlSyntax.Prelude (Data, Eq, Maybe, Ord, Show)+import PostgresqlSyntax.Algebra (IsAst, Refines)+import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary) data SelectWithParens@@ -18,8 +18,4 @@ instance Arbitrary SelectWithParens --- | See "PostgresqlSyntax.Ast.SelectWithParens" for the full documentation.-refineToSelectWithParens :: SelectWithParens -> Maybe SelectWithParens---- | See "PostgresqlSyntax.Ast.SelectWithParens" for the full documentation.-withParensSelectWithParens :: SelectWithParens -> SelectWithParens+instance Refines SelectWithParens SelectWithParens
library-internal/PostgresqlSyntax/Ast/SetClause.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.SetClause where +import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.SetTarget import PostgresqlSyntax.Ast.SetTargetList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SetClauseList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.SetClauseList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.SetClause import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SetTarget.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.SetTarget where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.Indirection import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SetTargetList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.SetTargetList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.SetTarget import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs view
@@ -1,12 +1,12 @@+{-# OPTIONS_GHC -Wno-orphans #-}+ module PostgresqlSyntax.Ast.SimpleSelect ( SimpleSelect (..),- baseSimpleSelect,- selectClauseBase,- extendSelectClause, ) where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FromClause import PostgresqlSyntax.Ast.GroupClause import PostgresqlSyntax.Ast.HavingClause@@ -21,11 +21,9 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import PostgresqlSyntax.Settings (Settings) import qualified Test.QuickCheck as Qc-import qualified Text.Megaparsec as Megaparsec -- | -- ==== References@@ -71,66 +69,115 @@ ValuesSimpleSelect a -> toTextBuilder settings a TableSimpleSelect a -> "TABLE " <> toTextBuilder settings a BinSimpleSelect a b c d -> toTextBuilder settings b <> " " <> toTextBuilder settings a <> foldMap (mappend " " . TextBuilders.renderAllOrDistinct) c <> " " <> toTextBuilder settings d- parser settings = do- a <- baseSimpleSelect settings <|> Parser.parse (Megaparsec.try (Parser.toParsec withParensHead))- extendMany suffix a- where- suffix headSimpleSelect = binopExtension (SimpleSelectSelectClause headSimpleSelect)- withParensHead = do- swp <- parser settings- binopExtension (WithParensSelectClause swp)- binopExtension headClause = do- op <- Parsers.space1 *> parser settings <* Parsers.space1- Parser.endHead- distinct <- optional (Parsers.allOrDistinct <* Parsers.space1)- rhs <- selectClauseBase settings >>= extendSelectClause settings- return (BinSimpleSelect op headClause distinct rhs) + -- ==== Law+ --+ -- @parser = parseExtended \@SelectClause \<|\> baseSimpleSelect@ — a bare+ -- 'SimpleSelect' is either a @select_clause@ chain of at least one+ -- @UNION@\/@INTERSECT@\/@EXCEPT@ (see 'Extends' below), or, failing+ -- that (no continuation follows), one of the non-chain base cases; it's+ -- never a bare, zero-extension @select_clause@ (that's not a+ -- 'SimpleSelect' at all — see 'SelectClause'). The chain alternative has+ -- to come first: trying 'baseSimpleSelect' alone would succeed on just+ -- the head of a chain and never look for what follows.+ parser settings = parseExtended @SelectClause settings <|> parseBase settings+ -- |--- The non-recursive base cases only (no @select_clause BINOP--- select_clause@ extension) — see this module's own boot-exposed--- signature.-baseSimpleSelect :: Settings -> Parser SimpleSelect-baseSimpleSelect settings =- asum- [ do- Parsers.keyword "select"- Parsers.notFollowedBy $ Parsers.satisfy isAlphaNum- Parser.endHead- targeting <- optional (Parsers.space1 *> parser settings)- intoClause <- optional (Parsers.space1 *> parser settings)- fromClause <- optional (Parsers.space1 *> parser settings)- whereClause <- optional (Parsers.space1 *> parser settings)- groupClause <- optional (Parsers.space1 *> parser settings)- havingClause <- optional (Parsers.space1 *> parser settings)- windowClause <- optional (Parsers.space1 *> parser settings)- return (NormalSimpleSelect targeting intoClause fromClause whereClause groupClause havingClause windowClause),- do- Parsers.keyword "table"- Parsers.space1- Parser.endHead- TableSimpleSelect <$> parser settings,- ValuesSimpleSelect <$> parser settings- ]+-- The @simple_select@ productions that don't left-recurse through+-- @select_clause@ — i.e. everything but @select_clause BINOP+-- select_clause@. "PostgresqlSyntax.Ast.SelectClause" reaches these+-- through this class method, which is why 'SimpleSelect' needs no helper+-- export.+instance LeftRecursive SimpleSelect where+ parseBase settings =+ asum+ [ do+ Parsers.keyword "select"+ Parsers.notFollowedBy $ Parsers.satisfy isAlphaNum+ Parser.endHead+ targeting <- optional (Parsers.space1 *> parser settings)+ intoClause <- optional (Parsers.space1 *> parser settings)+ fromClause <- optional (Parsers.space1 *> parser settings)+ whereClause <- optional (Parsers.space1 *> parser settings)+ groupClause <- optional (Parsers.space1 *> parser settings)+ havingClause <- optional (Parsers.space1 *> parser settings)+ windowClause <- optional (Parsers.space1 *> parser settings)+ return (NormalSimpleSelect targeting intoClause fromClause whereClause groupClause havingClause windowClause),+ do+ Parsers.keyword "table"+ Parsers.space1+ Parser.endHead+ TableSimpleSelect <$> parser settings,+ ValuesSimpleSelect <$> parser settings+ ] -selectClauseBase :: Settings -> Parser SelectClause-selectClauseBase settings =- asum- [ WithParensSelectClause <$> parser settings,- SimpleSelectSelectClause <$> baseSimpleSelect settings- ]+-- |+-- The left-recursion-eliminated form of @select_clause@: a bare+-- 'SelectClause' (either a parenthesized select, or one of+-- 'SimpleSelect'\'s non-chain cases) is the non-recursive base (@β@),+-- and each @UNION@\/@INTERSECT@\/@EXCEPT@ continuation is a+-- 'SelectBinOp' plus its @ALL@\/@DISTINCT@ qualifier and right operand,+-- applied via 'BinSimpleSelect'.+--+-- Keeps the collect-then-fold shape — parsing every 'SelectChainLink' up+-- front via 'parseExtensionChain', then folding via 'foldChain' — rather+-- than folding as it goes, because this hub's items aren't all one+-- precedence level: @gram.y@ declares @%left UNION EXCEPT@ before (i.e.+-- binding looser than) @%left INTERSECT@ (gram.y:813-814), both+-- left-associative, so a uniform left-to-right fold-as-you-parse would+-- root @a INTERSECT b UNION c@ at @INTERSECT@ and nest @a EXCEPT b EXCEPT+-- c@ to the right — both wrong. 'foldChain' needs the whole flat sequence+-- in hand to sort that out; see its own docs above.+instance Extends SelectClause SimpleSelect where+ parseExtensions settings lhs = foldChain lhs <$> parseLinks settings -extendSelectClause :: Settings -> SelectClause -> Parser SelectClause-extendSelectClause settings = extendMany suffix+-- |+-- One @UNION@\/@INTERSECT@\/@EXCEPT@ continuation, minus the left operand+-- it applies to.+data SelectChainLink = SelectChainLink SelectBinOp (Maybe Bool) SelectClause++parseLinks :: Settings -> Parser (NonEmpty SelectChainLink)+parseLinks settings = parseExtensionChain $ do+ op <- Parsers.space1 *> parser settings <* Parsers.space1+ Parser.endHead+ distinct <- optional (Parsers.allOrDistinct <* Parsers.space1)+ rhs <- parseBase @SelectClause settings+ return (SelectChainLink op distinct rhs)++-- |+-- ==== The precedence fold+--+-- @go@ applies items to the accumulator one at a time, left to right —+-- which by itself is already left-associative for a run of same-operator+-- items, INTERSECT included. What needs help is a /low-precedence/ item+-- (@UNION@\/@EXCEPT@) immediately followed by @INTERSECT@ items: those+-- bind tighter, so they must combine into that item's right operand+-- before @go@ applies it, not become separate steps of @go@'s own fold.+-- @absorbIntersect@ does exactly that — and only that: it leaves an+-- @INTERSECT@ item itself untouched (its rest is handled by @go@'s next+-- iteration, one item at a time), and otherwise absorbs a maximal+-- trailing run of @INTERSECT@ items into the current item's right+-- operand. @go@ then continues from whatever @absorbIntersect@ left+-- unconsumed, and either finishes (if nothing's left — the whole point of+-- ending on 'applyLink' rather than wrapping it back into a+-- @SelectClause@ is that the final combination must be the returned+-- @SimpleSelect@) or continues.+foldChain :: SelectClause -> NonEmpty SelectChainLink -> SimpleSelect+foldChain base (i0 :| is0) = go base i0 is0 where- suffix headSelectClause = SimpleSelectSelectClause <$> extensionSimpleSelect headSelectClause- extensionSimpleSelect headSelectClause = do- op <- Parsers.space1 *> parser settings <* Parsers.space1- Parser.endHead- distinct <- optional (Parsers.allOrDistinct <* Parsers.space1)- rhs <- selectClauseBase settings >>= extendSelectClause settings- return (BinSimpleSelect op headSelectClause distinct rhs)+ go acc item rest =+ let (absorbedItem, rest') = absorbIntersect item rest+ in case rest' of+ [] -> applyLink acc absorbedItem+ item' : rest'' -> go (SimpleSelectSelectClause (applyLink acc absorbedItem)) item' rest'' + applyLink lhs (SelectChainLink op distinct rhs) = BinSimpleSelect op lhs distinct rhs++ absorbIntersect item@(SelectChainLink IntersectSelectBinOp _ _) rest = (item, rest)+ absorbIntersect (SelectChainLink op distinct rhs) (SelectChainLink IntersectSelectBinOp d rhs' : rest) =+ absorbIntersect (SelectChainLink op distinct (SimpleSelectSelectClause (BinSimpleSelect IntersectSelectBinOp rhs d rhs'))) rest+ absorbIntersect item rest = (item, rest)+ instance Qc.Arbitrary SimpleSelect where shrink = fmap canonicalize . Qc.genericShrink arbitrary =@@ -156,29 +203,30 @@ ) -- |--- Collapses a left-associated @BinSimpleSelect@ chain (@(a OP1 b) OP2--- c@) to the right-associated shape (@a OP1 (b OP2 c)@) that the parser--- actually produces: 'parser' above parses each operator's right-hand--- side via 'extendSelectClause', which itself greedily consumes the rest--- of the chain before returning — so a chain of @N@ operators nests--- entirely to the right, and only that shape is reachable by parsing the--- rendered text (both shapes render identically, since rendering doesn't--- parenthesize chain elements). Both 'arbitrary' and 'shrink' can--- otherwise construct the non-canonical shape, which renders fine but--- parses back to a different, canonical value and so breaks the--- roundtrip property.-canonicalize :: SimpleSelect -> SimpleSelect-canonicalize s@(BinSimpleSelect {}) =- case rest of- (op, distinct, next) : more -> BinSimpleSelect op headClause distinct (buildRight next more)- [] -> s- where- (headClause, rest) = flattenChain (SimpleSelectSelectClause s)- buildRight lastClause [] = lastClause- buildRight clause ((op, distinct, next) : more) = SimpleSelectSelectClause (BinSimpleSelect op clause distinct (buildRight next more))- flattenChain (SimpleSelectSelectClause (BinSimpleSelect op lhs distinct rhs)) =- let (lhsHead, lhsRest) = flattenChain lhs- (rhsHead, rhsRest) = flattenChain rhs- in (lhsHead, lhsRest <> [(op, distinct, rhsHead)] <> rhsRest)- flattenChain c = (c, [])-canonicalize other = other+-- Collapses an arbitrary-shaped @BinSimpleSelect@ chain to the shape+-- 'foldChain' actually produces for it (left-associated within each+-- precedence level, @INTERSECT@ binding tighter than @UNION@\/@EXCEPT@ —+-- see 'foldChain' above): 'flattenChain' reduces the chain to its flat+-- sequence of operators and operands regardless of how it's currently+-- nested, and re-folding that sequence with the same 'foldChain' the+-- parser itself uses is by construction the shape @parse . toText@+-- produces. Both 'arbitrary' and 'shrink' can otherwise construct a+-- non-canonical shape, which renders fine but parses back to a+-- different, canonical value and so breaks the roundtrip property.+instance Canonicalizes SimpleSelect where+ canonicalize s@(BinSimpleSelect {}) =+ case flattenChain (SimpleSelectSelectClause s) of+ (headClause, i : is) -> foldChain headClause (i :| is)+ (_, []) -> s+ canonicalize other = other++-- |+-- Reduces a @BinSimpleSelect@ chain, in whatever shape it's currently+-- nested, to its leading operand and the flat, left-to-right sequence of+-- 'SelectChainLink' items that follow it — the inverse of 'foldChain'.+flattenChain :: SelectClause -> (SelectClause, [SelectChainLink])+flattenChain (SimpleSelectSelectClause (BinSimpleSelect op lhs distinct rhs)) =+ let (lhsHead, lhsRest) = flattenChain lhs+ (rhsHead, rhsRest) = flattenChain rhs+ in (lhsHead, lhsRest <> [SelectChainLink op distinct rhsHead] <> rhsRest)+flattenChain c = (c, [])
library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs-boot view
@@ -1,9 +1,10 @@+{-# OPTIONS_GHC -Wno-orphans #-}+ module PostgresqlSyntax.Ast.SimpleSelect where +import PostgresqlSyntax.Algebra (Extends, IsAst, LeftRecursive) import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectClause (SelectClause)-import PostgresqlSyntax.IsAst (IsAst)-import PostgresqlSyntax.Prelude (Data, Eq, Ord, Parser, Show)-import PostgresqlSyntax.Settings (Settings)+import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary) data SimpleSelect@@ -20,8 +21,6 @@ instance Arbitrary SimpleSelect -baseSimpleSelect :: Settings -> Parser SimpleSelect--selectClauseBase :: Settings -> Parser SelectClause+instance LeftRecursive SimpleSelect -extendSelectClause :: Settings -> SelectClause -> Parser SelectClause+instance Extends SelectClause SimpleSelect
library-internal/PostgresqlSyntax/Ast/SimpleTypename.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.SimpleTypename where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Bit import PostgresqlSyntax.Ast.Character import PostgresqlSyntax.Ast.ConstDatetime@@ -10,7 +11,6 @@ import PostgresqlSyntax.Ast.Numeric import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SortBy.hs view
@@ -1,14 +1,14 @@ module PostgresqlSyntax.Ast.SortBy where import qualified HeadedMegaparsec as Parser-import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr, filteredParser)+import PostgresqlSyntax.Algebra+import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.AscDesc import PostgresqlSyntax.Ast.NullsOrder import PostgresqlSyntax.Ast.QualAllOp import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, sortBy, try) import qualified Test.QuickCheck as Qc @@ -29,13 +29,7 @@ UsingSortBy a b c -> toTextBuilder settings a <> " USING " <> toTextBuilder settings b <> TextBuilders.suffixMaybe (toTextBuilder settings) c AscDescSortBy a b c -> toTextBuilder settings a <> TextBuilders.suffixMaybe (toTextBuilder settings) b <> TextBuilders.suffixMaybe (toTextBuilder settings) c parser settings = do- -- gram.y:14056 sortby. Of the four words that can terminate this- -- a_expr, only NULLS is unreserved (kwlist.h:315) and therefore a- -- legal ColId; USING/ASC/DESC are reserved (kwlist.h:496,47,138) and- -- can never be absorbed. Postgres disambiguates NULLS with a- -- two-token lexer lookahead (NULLS_LA, gram.y:864); this exclusion is- -- the coarser recursive-descent equivalent.- a <- filteredParser settings ["nulls"]+ a <- parser settings asum [ do Parsers.space1
library-internal/PostgresqlSyntax/Ast/SortClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.SortClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.SortBy import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, sortBy, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SubType.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.SubType where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SubqueryOp.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.SubqueryOp where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AllOp import PostgresqlSyntax.Ast.AnyOperator import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SubstrList.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.SubstrList where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.ExprList import PostgresqlSyntax.Ast.SubstrListFromFor import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SubstrListFromFor.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.SubstrListFromFor where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/SymbolicExprBinOp.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.SymbolicExprBinOp where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.MathOp import PostgresqlSyntax.Ast.QualOp-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TableFuncElement.hs view
@@ -1,13 +1,13 @@ module PostgresqlSyntax.Ast.TableFuncElement where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AnyName import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.Typename import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TableFuncElementList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.TableFuncElementList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.TableFuncElement import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TableRef.hs view
@@ -1,10 +1,13 @@-module PostgresqlSyntax.Ast.TableRef where+module PostgresqlSyntax.Ast.TableRef+ ( TableRef (..),+ )+where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.AliasClause import PostgresqlSyntax.Ast.FuncAliasClause import PostgresqlSyntax.Ast.FuncTable-import PostgresqlSyntax.Ast.JoinMeth import PostgresqlSyntax.Ast.JoinedTable import PostgresqlSyntax.Ast.RelationExpr import {-# SOURCE #-} PostgresqlSyntax.Ast.SelectWithParens (SelectWithParens)@@ -12,9 +15,7 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, head, many, some, tail, try)-import PostgresqlSyntax.Settings (Settings) import qualified Test.QuickCheck as Qc -- |@@ -33,14 +34,6 @@ -- -- TODO: Add xmltable -- @------ 'PostgresqlSyntax.Ast.JoinedTable' and 'PostgresqlSyntax.Ast.JoinMeth'--- have their own modules for the type declarations, but the actual--- parsing\/rendering of joined tables is hosted here (and here alone),--- since it's genuinely mutually recursive with table-ref parsing itself--- (a @table_ref@ can be a @joined_table@, and a @joined_table@'s branches--- each embed two @table_ref@s) — see the doc on 'JoinMeth' for why that--- type's own instance isn't what's used below. data TableRef = -- | -- @@@ -69,186 +62,93 @@ deriving (Show, Generic, Eq, Ord, Data) instance IsAst TableRef where- toTextBuilder settings = renderTableRef settings-- parser settings =- Parser.label "table reference" $- do- tr <- nonTrailingTableRef settings- recur settings tr---- |--- Renders a 'TableRef'. Also used, via 'renderJoinedTable', by--- "PostgresqlSyntax.Ast.JoinedTable"\'s own 'IsAst' instance — see the doc--- there for why that module doesn't maintain its own copy of this logic.-renderTableRef :: Settings -> TableRef -> TextBuilder-renderTableRef settings = \case- RelationExprTableRef a b c ->- TextBuilders.optLexemes- [ Just (toTextBuilder settings a),- fmap (toTextBuilder settings) b,- fmap (toTextBuilder settings) c- ]- FuncTableRef a b c ->- TextBuilders.optLexemes- [ if a then Just "LATERAL" else Nothing,- Just (toTextBuilder settings b),- fmap (toTextBuilder settings) c- ]- SelectTableRef a b c ->- TextBuilders.optLexemes- [ if a then Just "LATERAL" else Nothing,- Just (toTextBuilder settings b),- fmap (toTextBuilder settings) c- ]- JoinTableRef a b -> case b of- Just c -> TextBuilders.renderInParens (renderJoinedTable settings a) <> " " <> toTextBuilder settings c- Nothing -> renderJoinedTable settings a---- |--- Renders a 'PostgresqlSyntax.Ast.JoinedTable.JoinedTable'. This — not--- "PostgresqlSyntax.Ast.JoinedTable"\'s own 'IsAst' instance — is what--- actually gets used whenever a joined table is rendered as part of a--- 'TableRef', since a @table_ref@ and a @joined_table@ are genuinely--- mutually recursive (a @table_ref@ can be a @joined_table@, and a--- @joined_table@'s branches each embed two @table_ref@s), and only this--- module has both in scope non-abstractly at once. Exposed via the--- 'PostgresqlSyntax.Ast.TableRef.hs-boot' so--- "PostgresqlSyntax.Ast.JoinedTable" can delegate its own 'IsAst' instance--- to it, rather than maintaining a second, subtly different copy — see the--- doc on 'PostgresqlSyntax.Ast.JoinMeth' for why 'JoinMeth'\'s own instance--- still needs to differ from this one.-renderJoinedTable :: Settings -> JoinedTable -> TextBuilder-renderJoinedTable settings = \case- InParensJoinedTable a -> TextBuilders.renderInParens (renderJoinedTable settings a)- MethJoinedTable a b c -> case a of- CrossJoinMeth -> renderTableRef settings b <> " CROSS JOIN " <> renderTableRef settings c- QualJoinMeth d e -> renderTableRef settings b <> TextBuilders.suffixMaybe (toTextBuilder settings) d <> " JOIN " <> renderTableRef settings c <> " " <> toTextBuilder settings e- NaturalJoinMeth d -> renderTableRef settings b <> " NATURAL" <> TextBuilders.suffixMaybe (toTextBuilder settings) d <> " JOIN " <> renderTableRef settings c--recur :: Settings -> TableRef -> Parser TableRef-recur settings tr =- asum- [ do- tr2 <- Parser.wrapToHead (Parsers.space1 *> trailingTableRef settings tr)- Parser.endHead- recur settings tr2,- pure tr- ]--nonTrailingTableRef :: Settings -> Parser TableRef-nonTrailingTableRef settings =- asum- [lateralTableRef <|> Parser.wrapToHead nonLateralTableRef <|> relationExprTableRef <|> joinedTableWithAliasTableRef <|> inParensJoinedTableTableRef]- where- relationExprTableRef = do- relationExpr <- parser settings- Parser.endHead- optAliasClause <- optional (Parsers.space1 *> parser settings)- optTablesampleClause <- optional (Parsers.space1 *> parser settings)- return (RelationExprTableRef relationExpr optAliasClause optTablesampleClause)- lateralTableRef = do- Parsers.keyword "lateral"- Parsers.space1- Parser.endHead- lateralableTableRef True- nonLateralTableRef = lateralableTableRef False- lateralableTableRef lateral =- asum- [ do- a <- parser settings- b <- optional (Parsers.space1 *> parser settings)- return (FuncTableRef lateral a b),- do- select <- parser settings- optAliasClause <- optional $ Parsers.space1 *> parser settings- return (SelectTableRef lateral select optAliasClause)+ toTextBuilder settings = \case+ RelationExprTableRef a b c ->+ TextBuilders.optLexemes+ [ Just (toTextBuilder settings a),+ fmap (toTextBuilder settings) b,+ fmap (toTextBuilder settings) c ]- inParensJoinedTableTableRef = JoinTableRef <$> inParensJoinedTable settings <*> pure Nothing- joinedTableWithAliasTableRef = do- jt <- Parser.wrapToHead (Parsers.inParens (joinedTableParser settings))- Parsers.space1- alias <- parser settings- return (JoinTableRef jt (Just alias))--trailingTableRef :: Settings -> TableRef -> Parser TableRef-trailingTableRef settings tableRef =- JoinTableRef <$> trailingJoinedTable settings tableRef <*> pure Nothing---- |--- Parses a 'PostgresqlSyntax.Ast.JoinedTable.JoinedTable'. See--- 'renderJoinedTable' for why this — not--- "PostgresqlSyntax.Ast.JoinedTable"\'s own 'IsAst' instance — is what--- actually gets used to parse a joined table wherever one can occur inside a--- 'TableRef'.-joinedTableParser :: Settings -> Parser JoinedTable-joinedTableParser settings =- headP >>= tailP- where- headP =- asum- [ do- tr <- Parser.wrapToHead (nonTrailingTableRef settings)- Parsers.space1- trailingJoinedTable settings tr,- inParensJoinedTable settings+ FuncTableRef a b c ->+ TextBuilders.optLexemes+ [ if a then Just "LATERAL" else Nothing,+ Just (toTextBuilder settings b),+ fmap (toTextBuilder settings) c ]- tailP jt =- asum- [ do- jt2 <- Parser.wrapToHead (Parsers.space1 *> trailingJoinedTable settings (JoinTableRef jt Nothing))- Parser.endHead- tailP jt2,- pure jt+ SelectTableRef a b c ->+ TextBuilders.optLexemes+ [ if a then Just "LATERAL" else Nothing,+ Just (toTextBuilder settings b),+ fmap (toTextBuilder settings) c ]+ JoinTableRef a b -> case b of+ Just c -> TextBuilders.renderInParens (toTextBuilder settings a) <> " " <> toTextBuilder settings c+ Nothing -> toTextBuilder settings a --- ==== References--- @--- | '(' joined_table ')'--- @-inParensJoinedTable :: Settings -> Parser JoinedTable-inParensJoinedTable settings = InParensJoinedTable <$> Parsers.inParens (joinedTableParser settings)+ parser settings = Parser.label "table reference" (parseMaybeExtended @JoinedTable settings) --- ==== References--- @--- | table_ref CROSS JOIN table_ref--- | table_ref join_type JOIN table_ref join_qual--- | table_ref JOIN table_ref join_qual--- | table_ref NATURAL join_type JOIN table_ref--- | table_ref NATURAL JOIN table_ref--- @-trailingJoinedTable :: Settings -> TableRef -> Parser JoinedTable-trailingJoinedTable settings tr1 =- asum- [ do- Parsers.keyphrase "cross join"+-- |+-- 'PostgresqlSyntax.Ast.JoinedTable' embeds trivially into a bare,+-- alias-less 'TableRef' (@joined_table@ is one of @table_ref@'s+-- alternatives), and a 'TableRef' of that exact shape is recognizable back+-- as one. See 'PostgresqlSyntax.Algebra.Extends' for how this is used to+-- fold a chain of joins onto a leading 'TableRef'.+instance Refines JoinedTable TableRef where+ embed a = JoinTableRef a Nothing+ project = \case+ JoinTableRef a Nothing -> Just a+ _ -> Nothing++-- |+-- Every @table_ref@ production except the left-recursive ones (those are+-- the @joined_table@ continuations, hosted by+-- "PostgresqlSyntax.Ast.JoinedTable"\'s+-- 'PostgresqlSyntax.Algebra.Extends' instance).+--+-- The two @joined_table@-shaped alternatives here are /not/ left-recursive:+-- both begin with a parenthesis, so neither can loop back into this parser+-- without consuming input. They reach @'(' joined_table ')'@ through+-- 'JoinedTable'\'s own 'parseBase' rather than through a+-- 'JoinedTable' helper export.+instance LeftRecursive TableRef where+ parseBase settings =+ asum+ [ lateralTableRef,+ Parser.wrapToHead nonLateralTableRef,+ relationExprTableRef,+ joinedTableWithAliasTableRef,+ inParensJoinedTableTableRef+ ]+ where+ relationExprTableRef = do+ relationExpr <- parser settings Parser.endHead+ optAliasClause <- optional (Parsers.space1 *> parser settings)+ optTablesampleClause <- optional (Parsers.space1 *> parser settings)+ return (RelationExprTableRef relationExpr optAliasClause optTablesampleClause)+ lateralTableRef = do+ Parsers.keyword "lateral" Parsers.space1- tr2 <- nonTrailingTableRef settings- return (MethJoinedTable CrossJoinMeth tr1 tr2),- do- jt <- joinTypedJoin Parser.endHead- Parsers.space1- tr2 <- parser settings- Parsers.space1- jq <- parser settings- return (MethJoinedTable (QualJoinMeth jt jq) tr1 tr2),- do- Parsers.keyword "natural"- Parser.endHead- Parsers.space1- jt <- joinTypedJoin+ lateralableTableRef True+ nonLateralTableRef = lateralableTableRef False+ lateralableTableRef lateral =+ asum+ [ do+ a <- parser settings+ b <- optional (Parsers.space1 *> parser settings)+ return (FuncTableRef lateral a b),+ do+ select <- parser settings+ optAliasClause <- optional $ Parsers.space1 *> parser settings+ return (SelectTableRef lateral select optAliasClause)+ ]+ inParensJoinedTableTableRef = JoinTableRef <$> parseBase @JoinedTable settings <*> pure Nothing+ joinedTableWithAliasTableRef = do+ jt <- Parser.wrapToHead (Parsers.inParens (parser settings)) Parsers.space1- tr2 <- nonTrailingTableRef settings- return (MethJoinedTable (NaturalJoinMeth jt) tr1 tr2)- ]- where- joinTypedJoin =- Just- <$> (parser settings <* Parser.endHead <* Parsers.space1 <* Parsers.keyword "join")- <|> Nothing- <$ Parsers.keyword "join"+ alias <- parser settings+ return (JoinTableRef jt (Just alias)) instance Qc.Arbitrary TableRef where shrink = Qc.genericShrink
library-internal/PostgresqlSyntax/Ast/TableRef.hs-boot view
@@ -1,9 +1,8 @@ module PostgresqlSyntax.Ast.TableRef where +import PostgresqlSyntax.Algebra (IsAst, LeftRecursive, Refines) import {-# SOURCE #-} PostgresqlSyntax.Ast.JoinedTable (JoinedTable)-import PostgresqlSyntax.IsAst (IsAst)-import PostgresqlSyntax.Prelude (Data, Eq, Ord, Parser, Show, TextBuilder)-import PostgresqlSyntax.Settings (Settings)+import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary) data TableRef@@ -20,13 +19,6 @@ instance Arbitrary TableRef --- | See "PostgresqlSyntax.Ast.TableRef" for the full documentation. The--- actual rendering logic for 'PostgresqlSyntax.Ast.JoinedTable', exposed so--- that module's own 'IsAst' instance can delegate to it instead of--- maintaining a second, subtly different copy.-renderJoinedTable :: Settings -> JoinedTable -> TextBuilder+instance Refines JoinedTable TableRef --- | See "PostgresqlSyntax.Ast.TableRef" for the full documentation. The--- actual parsing logic for 'PostgresqlSyntax.Ast.JoinedTable', exposed for--- the same reason as 'renderJoinedTable'.-joinedTableParser :: Settings -> Parser JoinedTable+instance LeftRecursive TableRef
library-internal/PostgresqlSyntax/Ast/TablesampleClause.hs view
@@ -1,13 +1,13 @@ module PostgresqlSyntax.Ast.TablesampleClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.ExprList import PostgresqlSyntax.Ast.FuncName import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TargetEl.hs view
@@ -1,12 +1,11 @@ module PostgresqlSyntax.Ast.TargetEl where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr)-import {-# SOURCE #-} qualified PostgresqlSyntax.Ast.AExpr as AExpr import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.KeywordSet as KeywordSet import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc@@ -66,14 +65,6 @@ Qc.oneof [ pure AsteriskTargetEl, AliasedExprTargetEl <$> Gens.downscale Qc.arbitrary <*> Qc.arbitrary,- -- Unlike 'AliasedExprTargetEl' (separated from its alias by the- -- reserved @AS@ Parsers.keyword) or 'ExprTargetEl' (followed only by a- -- comma\/end of list, neither valid @a_expr@ continuations), the- -- expr here is followed directly by a bare alias identifier with- -- nothing but a space — exactly the hazard- -- 'PostgresqlSyntax.Ast.AExpr.isBoundedAExprOperand' guards- -- against (e.g. rendering an 'PostgresqlSyntax.Ast.AExpr.OrAExpr'- -- bare here would let its right operand absorb the alias).- ImplicitlyAliasedExprTargetEl <$> AExpr.safeAExprOperand (Gens.downscale Qc.arbitrary) <*> Qc.arbitrary,+ ImplicitlyAliasedExprTargetEl <$> Gens.downscale Qc.arbitrary <*> Qc.arbitrary, ExprTargetEl <$> Gens.downscale Qc.arbitrary ]
library-internal/PostgresqlSyntax/Ast/TargetList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.TargetList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.TargetEl import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Targeting.hs view
@@ -1,12 +1,12 @@ module PostgresqlSyntax.Ast.Targeting where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExprList import PostgresqlSyntax.Ast.TargetList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Timezone.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.Timezone where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TrimList.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.TrimList where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.ExprList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TrimModifier.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.TrimModifier where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TypeList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.TypeList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Typename import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/Typename.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.Typename where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.SimpleTypename import PostgresqlSyntax.Ast.TypenameArrayDimensions import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import PostgresqlSyntax.Settings (resolveNullabilityMarkers) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/TypenameArrayDimensions.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.TypenameArrayDimensions where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ArrayBounds import PostgresqlSyntax.Ast.Iconst import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/UpdateStmt.hs view
@@ -1,9 +1,9 @@ module PostgresqlSyntax.Ast.UpdateStmt where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FromClause import PostgresqlSyntax.Ast.RelationExprOptAlias (RelationExprOptAlias)-import qualified PostgresqlSyntax.Ast.RelationExprOptAlias as RelationExprOptAlias import PostgresqlSyntax.Ast.ReturningClause import PostgresqlSyntax.Ast.SetClauseList import PostgresqlSyntax.Ast.WhereOrCurrentClause@@ -11,7 +11,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc @@ -44,7 +43,7 @@ Parsers.keyword "update" Parsers.space1 Parser.endHead- b <- RelationExprOptAlias.customizedParser settings ["set"]+ b <- parser settings Parsers.space1 Parsers.keyword "set" Parsers.space1
library-internal/PostgresqlSyntax/Ast/UsingClause.hs view
@@ -1,8 +1,8 @@ module PostgresqlSyntax.Ast.UsingClause where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.FromList import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/ValuesClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.ValuesClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExprList import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/VerbalExprBinOp.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.VerbalExprBinOp where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WhenClause.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.WhenClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WhenClauseList.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.WhenClauseList where +import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.WhenClause import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WhereClause.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.WhereClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WhereOrCurrentClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.WhereOrCurrentClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import {-# SOURCE #-} PostgresqlSyntax.Ast.AExpr (AExpr) import PostgresqlSyntax.Ast.Ident import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WindowClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.WindowClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.WindowDefinition import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude hiding (filter, many, some, try) import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WindowDefinition.hs view
@@ -1,10 +1,10 @@ module PostgresqlSyntax.Ast.WindowDefinition where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.Ident import PostgresqlSyntax.Ast.WindowSpecification import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WindowExclusionClause.hs view
@@ -1,7 +1,7 @@ module PostgresqlSyntax.Ast.WindowExclusionClause where +import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WindowSpecification.hs view
@@ -1,6 +1,7 @@ module PostgresqlSyntax.Ast.WindowSpecification where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.ExprList import PostgresqlSyntax.Ast.FrameClause import PostgresqlSyntax.Ast.Ident@@ -8,7 +9,6 @@ import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WithClause.hs view
@@ -1,11 +1,11 @@ module PostgresqlSyntax.Ast.WithClause where import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import PostgresqlSyntax.Ast.CommonTableExpr (CommonTableExpr) import qualified PostgresqlSyntax.Helpers.Gens as Gens import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.TextBuilders as TextBuilders-import PostgresqlSyntax.IsAst import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Ast/WithClause.hs-boot view
@@ -1,6 +1,6 @@ module PostgresqlSyntax.Ast.WithClause where -import PostgresqlSyntax.IsAst (IsAst)+import PostgresqlSyntax.Algebra (IsAst) import PostgresqlSyntax.Prelude (Data, Eq, Ord, Show) import Test.QuickCheck (Arbitrary)
library-internal/PostgresqlSyntax/Ast/Xconst.hs view
@@ -2,9 +2,9 @@ import qualified Data.Text as Text import qualified HeadedMegaparsec as Parser+import PostgresqlSyntax.Algebra import qualified PostgresqlSyntax.Helpers.Parsers as Parsers import qualified PostgresqlSyntax.Helpers.Shrinks as Shrinks-import PostgresqlSyntax.IsAst import qualified PostgresqlSyntax.Predicate as Predicate import PostgresqlSyntax.Prelude import qualified Test.QuickCheck as Qc
library-internal/PostgresqlSyntax/Helpers/Parsers.hs view
@@ -10,8 +10,8 @@ import qualified Data.HashSet as HashSet import qualified Data.Text as Text import HeadedMegaparsec hiding (string)+import PostgresqlSyntax.Algebra hiding (parse, parseWithPosError, toText) import PostgresqlSyntax.Extras.HeadedMegaparsec hiding (run)-import PostgresqlSyntax.IsAst hiding (parse, parseWithPosError, toText) import qualified PostgresqlSyntax.KeywordSet as KeywordSet import qualified PostgresqlSyntax.Predicate as Predicate import PostgresqlSyntax.Prelude hiding (bit, expr, filter, fromList, head, many, option, some, sortBy, tail, try)@@ -126,7 +126,14 @@ do firstChar <- Megaparsec.satisfy Predicate.firstIdentifierChar remainder <- Megaparsec.takeWhileP Nothing Predicate.notFirstIdentifierChar- return (Text.toLower (Text.cons firstChar remainder))+ let parsedKeyword = Text.toLower (Text.cons firstChar remainder)+ when (parsedKeyword == "nulls") (Megaparsec.notFollowedBy nullsLa)+ return parsedKeyword+ where+ nullsLa =+ MegaparsecChar.space1+ *> (MegaparsecChar.string' "first" <|> MegaparsecChar.string' "last")+ *> Megaparsec.notFollowedBy (Megaparsec.satisfy Predicate.notFirstIdentifierChar) -- | Expected keyword --@@ -209,11 +216,12 @@ -- A ColId-like identifier parser (unreserved keyword ∪ col-name keyword) -- restricted to exclude the given reserved words — needed wherever a -- trailing bare word must terminate a construct instead of being consumed--- as an identifier (e.g. 'PostgresqlSyntax.Ast.SortBy'\'s--- @USING@\/@ASC@\/@DESC@\/@NULLS@,--- 'PostgresqlSyntax.Ast.RelationExprOptAlias'\'s alias-terminating--- keywords). @identParser@ is the identifier type's own plain (unfiltered)--- parser, tried first, same as plain @ColId@ does.+-- as an identifier. Its only caller is+-- 'PostgresqlSyntax.Ast.RelationExprOptAlias', which excludes @SET@ only in+-- its bare (non-@AS@) alias branch, per @gram.y@'s+-- @relation_expr_opt_alias@ shift/reduce resolution. @identParser@ is the+-- identifier type's own plain (unfiltered) parser, tried first, same as+-- plain @ColId@ does. filteredColIdLike :: (Text -> a) -> Parser a -> [Text] -> Parser a filteredColIdLike wrap identParser excluded = label "identifier" $
− library-internal/PostgresqlSyntax/IsAst.hs
@@ -1,44 +0,0 @@-module PostgresqlSyntax.IsAst- ( IsAst (..),- toText,- parse,- parseWithPosError,- parseWithSourcePosError,- )-where--import qualified Data.Text as Text-import qualified PostgresqlSyntax.Extras.HeadedMegaparsec as Extras-import PostgresqlSyntax.Prelude-import PostgresqlSyntax.Settings (Settings)-import qualified Text.Megaparsec as Megaparsec-import qualified TextBuilder--class IsAst a where- toTextBuilder :: Settings -> a -> TextBuilder- parser :: Settings -> Parser a---- |--- Render a value to 'Text' via its 'toTextBuilder' method.-toText :: (IsAst a) => Settings -> a -> Text-toText settings = TextBuilder.toText . toTextBuilder settings---- |--- Parse a 'Text' input with the type's 'parser', returning either a--- pretty-printed error or the parsed value. The parser is chosen by the--- caller's type inference (via the 'IsAst' constraint), so callers no longer--- pass an explicit parser argument.-parse :: (IsAst a) => Settings -> Text -> Either Text a-parse settings = first Text.pack . Extras.run (Extras.totally (parser settings))---- |--- Like 'parse' but returns the structured error list (each error paired with--- its byte offset) instead of a single pretty-printed message.-parseWithPosError :: (IsAst a) => Settings -> Text -> Either (NonEmpty (Int, Text)) a-parseWithPosError settings = first (fmap (second Text.pack)) . Extras.runParserWithErrorPos (Extras.totally (parser settings))---- |--- Like 'parseWithPosError' but pairs each error with its--- 'Text.Megaparsec.SourcePos' instead of a raw byte offset.-parseWithSourcePosError :: (IsAst a) => Settings -> Text -> Either (NonEmpty (Megaparsec.SourcePos, Text)) a-parseWithSourcePosError settings = first (fmap (second Text.pack)) . Extras.runParserWithSourcePosError (Extras.totally (parser settings))
library-internal/PostgresqlSyntax/Prelude.hs view
@@ -67,6 +67,7 @@ import GHC.IO.Exception as Exports import qualified HeadedMegaparsec import Numeric as Exports+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports@@ -80,7 +81,6 @@ import Text.Read as Exports (Read (..), readEither, readMaybe) import TextBuilder as Exports (TextBuilder) import Unsafe.Coerce as Exports-import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) -- | -- Compose a monad, which attempts to extend a value, based on the following input.
library-internal/PostgresqlSyntax/Settings.hs view
@@ -1,5 +1,5 @@ -- |--- Parse\/render options for the 'PostgresqlSyntax.IsAst' machinery.+-- Parse\/render options for the 'PostgresqlSyntax.Algebra' machinery. -- -- The type is abstract: build a 'Settings' value with 'nullabilityMarkers' and -- combine values with their 'Semigroup'\/'Monoid' instances ('mempty' is@@ -16,9 +16,7 @@ import PostgresqlSyntax.Prelude -- |--- \@Settings {optNullabilityMarkers = Nothing}\@ everywhere means standard--- Postgres. The only knob today is whether the 'PostgresqlSyntax.Ast.Typename'--- @?@ nullability markers are recognized.+-- Collection of parse\/render options. Use 'nullabilityMarkers' to build a value, and combine values with their 'Semigroup'\/'Monoid' instances ('mempty' is faithful, standard Postgres). data Settings = Settings {optNullabilityMarkers :: Maybe Bool} deriving (Show, Eq)
library/PostgresqlSyntax.hs view
@@ -12,11 +12,11 @@ -- 'mempty' for standard Postgres syntax. module PostgresqlSyntax ( -- * Parsing and rendering- IsAst.IsAst (..),- IsAst.toText,- IsAst.parse,- IsAst.parseWithPosError,- IsAst.parseWithSourcePosError,+ Algebra.IsAst (..),+ Algebra.toText,+ Algebra.parse,+ Algebra.parseWithPosError,+ Algebra.parseWithSourcePosError, -- * Settings Settings.Settings,@@ -27,6 +27,6 @@ ) where +import qualified PostgresqlSyntax.Algebra as Algebra import PostgresqlSyntax.Ast-import qualified PostgresqlSyntax.IsAst as IsAst import qualified PostgresqlSyntax.Settings as Settings
nesting-bench/Main.hs view
@@ -14,8 +14,8 @@ import Control.Concurrent.MVar import qualified Data.Text as Text import PostgresqlSyntax (AExpr, parse)-import System.Clock import Prelude+import System.Clock -- * Inputs
postgresql-syntax.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-syntax-version: 0.5.0.1+version: 0.5.0.2 category: Database, PostgreSQL, Parsing synopsis: PostgreSQL AST parsing and rendering description:@@ -66,6 +66,7 @@ import: base-settings hs-source-dirs: library-internal exposed-modules:+ PostgresqlSyntax.Algebra PostgresqlSyntax.Ast PostgresqlSyntax.Ast.AExpr PostgresqlSyntax.Ast.AexprConst@@ -140,7 +141,6 @@ PostgresqlSyntax.Ast.IntervalSecond PostgresqlSyntax.Ast.IntoClause PostgresqlSyntax.Ast.JoinedTable- PostgresqlSyntax.Ast.JoinMeth PostgresqlSyntax.Ast.JoinQual PostgresqlSyntax.Ast.JoinType PostgresqlSyntax.Ast.LimitClause@@ -227,7 +227,6 @@ PostgresqlSyntax.Helpers.Parsers PostgresqlSyntax.Helpers.Shrinks PostgresqlSyntax.Helpers.TextBuilders- PostgresqlSyntax.IsAst PostgresqlSyntax.KeywordSet PostgresqlSyntax.Predicate PostgresqlSyntax.Prelude@@ -335,7 +334,6 @@ Ast.IntervalSpec Ast.IntoClauseSpec Ast.JoinedTableSpec- Ast.JoinMethSpec Ast.JoinQualSpec Ast.JoinTypeSpec Ast.LimitClauseSpec