diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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') diff --git a/hspec-test/Ast/AExprSpec.hs b/hspec-test/Ast/AExprSpec.hs --- a/hspec-test/Ast/AExprSpec.hs +++ b/hspec-test/Ast/AExprSpec.hs @@ -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 diff --git a/hspec-test/Ast/CExprSpec.hs b/hspec-test/Ast/CExprSpec.hs --- a/hspec-test/Ast/CExprSpec.hs +++ b/hspec-test/Ast/CExprSpec.hs @@ -7,4 +7,5 @@ spec :: Spec spec = do itSatisfiesIsAst @CExpr + itSatisfiesCanonicalizes @CExpr itSatisfiesArbitrary @CExpr diff --git a/hspec-test/Ast/DeleteStmtSpec.hs b/hspec-test/Ast/DeleteStmtSpec.hs --- a/hspec-test/Ast/DeleteStmtSpec.hs +++ b/hspec-test/Ast/DeleteStmtSpec.hs @@ -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" diff --git a/hspec-test/Ast/FrameBoundSpec.hs b/hspec-test/Ast/FrameBoundSpec.hs --- a/hspec-test/Ast/FrameBoundSpec.hs +++ b/hspec-test/Ast/FrameBoundSpec.hs @@ -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 diff --git a/hspec-test/Ast/InExprSpec.hs b/hspec-test/Ast/InExprSpec.hs --- a/hspec-test/Ast/InExprSpec.hs +++ b/hspec-test/Ast/InExprSpec.hs @@ -7,4 +7,5 @@ spec :: Spec spec = do itSatisfiesIsAst @InExpr + itSatisfiesCanonicalizes @InExpr itSatisfiesArbitrary @InExpr diff --git a/hspec-test/Ast/IndexElemSpec.hs b/hspec-test/Ast/IndexElemSpec.hs --- a/hspec-test/Ast/IndexElemSpec.hs +++ b/hspec-test/Ast/IndexElemSpec.hs @@ -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 diff --git a/hspec-test/Ast/InsertRestSpec.hs b/hspec-test/Ast/InsertRestSpec.hs --- a/hspec-test/Ast/InsertRestSpec.hs +++ b/hspec-test/Ast/InsertRestSpec.hs @@ -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)" diff --git a/hspec-test/Ast/InsertStmtSpec.hs b/hspec-test/Ast/InsertStmtSpec.hs --- a/hspec-test/Ast/InsertStmtSpec.hs +++ b/hspec-test/Ast/InsertStmtSpec.hs @@ -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))" diff --git a/hspec-test/Ast/JoinMethSpec.hs b/hspec-test/Ast/JoinMethSpec.hs deleted file mode 100644 --- a/hspec-test/Ast/JoinMethSpec.hs +++ /dev/null @@ -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 diff --git a/hspec-test/Ast/OpSpec.hs b/hspec-test/Ast/OpSpec.hs --- a/hspec-test/Ast/OpSpec.hs +++ b/hspec-test/Ast/OpSpec.hs @@ -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 diff --git a/hspec-test/Ast/PreparableStmtSpec.hs b/hspec-test/Ast/PreparableStmtSpec.hs --- a/hspec-test/Ast/PreparableStmtSpec.hs +++ b/hspec-test/Ast/PreparableStmtSpec.hs @@ -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 diff --git a/hspec-test/Ast/SconstSpec.hs b/hspec-test/Ast/SconstSpec.hs --- a/hspec-test/Ast/SconstSpec.hs +++ b/hspec-test/Ast/SconstSpec.hs @@ -2,8 +2,8 @@ import Helpers.Specs import PostgresqlSyntax.Ast.Sconst -import Test.Hspec import Prelude +import Test.Hspec spec :: Spec spec = do diff --git a/hspec-test/Ast/SelectClauseSpec.hs b/hspec-test/Ast/SelectClauseSpec.hs --- a/hspec-test/Ast/SelectClauseSpec.hs +++ b/hspec-test/Ast/SelectClauseSpec.hs @@ -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 diff --git a/hspec-test/Ast/SelectNoParensSpec.hs b/hspec-test/Ast/SelectNoParensSpec.hs --- a/hspec-test/Ast/SelectNoParensSpec.hs +++ b/hspec-test/Ast/SelectNoParensSpec.hs @@ -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 diff --git a/hspec-test/Ast/SelectWithParensSpec.hs b/hspec-test/Ast/SelectWithParensSpec.hs --- a/hspec-test/Ast/SelectWithParensSpec.hs +++ b/hspec-test/Ast/SelectWithParensSpec.hs @@ -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. diff --git a/hspec-test/Ast/SimpleSelectSpec.hs b/hspec-test/Ast/SimpleSelectSpec.hs --- a/hspec-test/Ast/SimpleSelectSpec.hs +++ b/hspec-test/Ast/SimpleSelectSpec.hs @@ -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 +-- 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) diff --git a/hspec-test/Ast/SortBySpec.hs b/hspec-test/Ast/SortBySpec.hs --- a/hspec-test/Ast/SortBySpec.hs +++ b/hspec-test/Ast/SortBySpec.hs @@ -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" diff --git a/hspec-test/Ast/TableRefSpec.hs b/hspec-test/Ast/TableRefSpec.hs --- a/hspec-test/Ast/TableRefSpec.hs +++ b/hspec-test/Ast/TableRefSpec.hs @@ -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 diff --git a/hspec-test/Ast/TypenameSpec.hs b/hspec-test/Ast/TypenameSpec.hs --- a/hspec-test/Ast/TypenameSpec.hs +++ b/hspec-test/Ast/TypenameSpec.hs @@ -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 diff --git a/hspec-test/Ast/UpdateStmtSpec.hs b/hspec-test/Ast/UpdateStmtSpec.hs --- a/hspec-test/Ast/UpdateStmtSpec.hs +++ b/hspec-test/Ast/UpdateStmtSpec.hs @@ -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" diff --git a/hspec-test/Ast/WindowSpecificationSpec.hs b/hspec-test/Ast/WindowSpecificationSpec.hs --- a/hspec-test/Ast/WindowSpecificationSpec.hs +++ b/hspec-test/Ast/WindowSpecificationSpec.hs @@ -2,8 +2,8 @@ import Helpers.Specs import PostgresqlSyntax.Ast.WindowSpecification -import Test.Hspec import Prelude +import Test.Hspec spec :: Spec spec = do diff --git a/hspec-test/Helpers/Expectations.hs b/hspec-test/Helpers/Expectations.hs --- a/hspec-test/Helpers/Expectations.hs +++ b/hspec-test/Helpers/Expectations.hs @@ -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 = diff --git a/hspec-test/Helpers/Specs.hs b/hspec-test/Helpers/Specs.hs --- a/hspec-test/Helpers/Specs.hs +++ b/hspec-test/Helpers/Specs.hs @@ -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 = diff --git a/hspec-test/Main.hs b/hspec-test/Main.hs --- a/hspec-test/Main.hs +++ b/hspec-test/Main.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Algebra.hs b/library-internal/PostgresqlSyntax/Algebra.hs new file mode 100644 --- /dev/null +++ b/library-internal/PostgresqlSyntax/Algebra.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast.hs b/library-internal/PostgresqlSyntax/Ast.hs --- a/library-internal/PostgresqlSyntax/Ast.hs +++ b/library-internal/PostgresqlSyntax/Ast.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AExpr.hs b/library-internal/PostgresqlSyntax/Ast/AExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/AExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/AExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AExpr.hs-boot b/library-internal/PostgresqlSyntax/Ast/AExpr.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/AExpr.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/AExpr.hs-boot @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AExprReversableOp.hs b/library-internal/PostgresqlSyntax/Ast/AExprReversableOp.hs --- a/library-internal/PostgresqlSyntax/Ast/AExprReversableOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/AExprReversableOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AexprConst.hs b/library-internal/PostgresqlSyntax/Ast/AexprConst.hs --- a/library-internal/PostgresqlSyntax/Ast/AexprConst.hs +++ b/library-internal/PostgresqlSyntax/Ast/AexprConst.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AliasClause.hs b/library-internal/PostgresqlSyntax/Ast/AliasClause.hs --- a/library-internal/PostgresqlSyntax/Ast/AliasClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/AliasClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AllOp.hs b/library-internal/PostgresqlSyntax/Ast/AllOp.hs --- a/library-internal/PostgresqlSyntax/Ast/AllOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/AllOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AnyName.hs b/library-internal/PostgresqlSyntax/Ast/AnyName.hs --- a/library-internal/PostgresqlSyntax/Ast/AnyName.hs +++ b/library-internal/PostgresqlSyntax/Ast/AnyName.hs @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/AnyOperator.hs b/library-internal/PostgresqlSyntax/Ast/AnyOperator.hs --- a/library-internal/PostgresqlSyntax/Ast/AnyOperator.hs +++ b/library-internal/PostgresqlSyntax/Ast/AnyOperator.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ArrayBounds.hs b/library-internal/PostgresqlSyntax/Ast/ArrayBounds.hs --- a/library-internal/PostgresqlSyntax/Ast/ArrayBounds.hs +++ b/library-internal/PostgresqlSyntax/Ast/ArrayBounds.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs b/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs-boot b/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/ArrayExpr.hs-boot @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/ArrayExprList.hs b/library-internal/PostgresqlSyntax/Ast/ArrayExprList.hs --- a/library-internal/PostgresqlSyntax/Ast/ArrayExprList.hs +++ b/library-internal/PostgresqlSyntax/Ast/ArrayExprList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/AscDesc.hs b/library-internal/PostgresqlSyntax/Ast/AscDesc.hs --- a/library-internal/PostgresqlSyntax/Ast/AscDesc.hs +++ b/library-internal/PostgresqlSyntax/Ast/AscDesc.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Attrs.hs b/library-internal/PostgresqlSyntax/Ast/Attrs.hs --- a/library-internal/PostgresqlSyntax/Ast/Attrs.hs +++ b/library-internal/PostgresqlSyntax/Ast/Attrs.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/BExpr.hs b/library-internal/PostgresqlSyntax/Ast/BExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/BExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/BExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/BExpr.hs-boot b/library-internal/PostgresqlSyntax/Ast/BExpr.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/BExpr.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/BExpr.hs-boot @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/BExprIsOp.hs b/library-internal/PostgresqlSyntax/Ast/BExprIsOp.hs --- a/library-internal/PostgresqlSyntax/Ast/BExprIsOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/BExprIsOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Bconst.hs b/library-internal/PostgresqlSyntax/Ast/Bconst.hs --- a/library-internal/PostgresqlSyntax/Ast/Bconst.hs +++ b/library-internal/PostgresqlSyntax/Ast/Bconst.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Bit.hs b/library-internal/PostgresqlSyntax/Ast/Bit.hs --- a/library-internal/PostgresqlSyntax/Ast/Bit.hs +++ b/library-internal/PostgresqlSyntax/Ast/Bit.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/CExpr.hs b/library-internal/PostgresqlSyntax/Ast/CExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/CExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/CExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/CallStmt.hs b/library-internal/PostgresqlSyntax/Ast/CallStmt.hs --- a/library-internal/PostgresqlSyntax/Ast/CallStmt.hs +++ b/library-internal/PostgresqlSyntax/Ast/CallStmt.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/CaseExpr.hs b/library-internal/PostgresqlSyntax/Ast/CaseExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/CaseExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/CaseExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Character.hs b/library-internal/PostgresqlSyntax/Ast/Character.hs --- a/library-internal/PostgresqlSyntax/Ast/Character.hs +++ b/library-internal/PostgresqlSyntax/Ast/Character.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Columnref.hs b/library-internal/PostgresqlSyntax/Ast/Columnref.hs --- a/library-internal/PostgresqlSyntax/Ast/Columnref.hs +++ b/library-internal/PostgresqlSyntax/Ast/Columnref.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/CommonTableExpr.hs b/library-internal/PostgresqlSyntax/Ast/CommonTableExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/CommonTableExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/CommonTableExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ConfExpr.hs b/library-internal/PostgresqlSyntax/Ast/ConfExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/ConfExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/ConfExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ConstCharacter.hs b/library-internal/PostgresqlSyntax/Ast/ConstCharacter.hs --- a/library-internal/PostgresqlSyntax/Ast/ConstCharacter.hs +++ b/library-internal/PostgresqlSyntax/Ast/ConstCharacter.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ConstDatetime.hs b/library-internal/PostgresqlSyntax/Ast/ConstDatetime.hs --- a/library-internal/PostgresqlSyntax/Ast/ConstDatetime.hs +++ b/library-internal/PostgresqlSyntax/Ast/ConstDatetime.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ConstTypename.hs b/library-internal/PostgresqlSyntax/Ast/ConstTypename.hs --- a/library-internal/PostgresqlSyntax/Ast/ConstTypename.hs +++ b/library-internal/PostgresqlSyntax/Ast/ConstTypename.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/DeleteStmt.hs b/library-internal/PostgresqlSyntax/Ast/DeleteStmt.hs --- a/library-internal/PostgresqlSyntax/Ast/DeleteStmt.hs +++ b/library-internal/PostgresqlSyntax/Ast/DeleteStmt.hs @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/ExplicitRow.hs b/library-internal/PostgresqlSyntax/Ast/ExplicitRow.hs --- a/library-internal/PostgresqlSyntax/Ast/ExplicitRow.hs +++ b/library-internal/PostgresqlSyntax/Ast/ExplicitRow.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ExprList.hs b/library-internal/PostgresqlSyntax/Ast/ExprList.hs --- a/library-internal/PostgresqlSyntax/Ast/ExprList.hs +++ b/library-internal/PostgresqlSyntax/Ast/ExprList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ExtractArg.hs b/library-internal/PostgresqlSyntax/Ast/ExtractArg.hs --- a/library-internal/PostgresqlSyntax/Ast/ExtractArg.hs +++ b/library-internal/PostgresqlSyntax/Ast/ExtractArg.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ExtractList.hs b/library-internal/PostgresqlSyntax/Ast/ExtractList.hs --- a/library-internal/PostgresqlSyntax/Ast/ExtractList.hs +++ b/library-internal/PostgresqlSyntax/Ast/ExtractList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Fconst.hs b/library-internal/PostgresqlSyntax/Ast/Fconst.hs --- a/library-internal/PostgresqlSyntax/Ast/Fconst.hs +++ b/library-internal/PostgresqlSyntax/Ast/Fconst.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ForLockingClause.hs b/library-internal/PostgresqlSyntax/Ast/ForLockingClause.hs --- a/library-internal/PostgresqlSyntax/Ast/ForLockingClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/ForLockingClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ForLockingItem.hs b/library-internal/PostgresqlSyntax/Ast/ForLockingItem.hs --- a/library-internal/PostgresqlSyntax/Ast/ForLockingItem.hs +++ b/library-internal/PostgresqlSyntax/Ast/ForLockingItem.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ForLockingStrength.hs b/library-internal/PostgresqlSyntax/Ast/ForLockingStrength.hs --- a/library-internal/PostgresqlSyntax/Ast/ForLockingStrength.hs +++ b/library-internal/PostgresqlSyntax/Ast/ForLockingStrength.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FrameBound.hs b/library-internal/PostgresqlSyntax/Ast/FrameBound.hs --- a/library-internal/PostgresqlSyntax/Ast/FrameBound.hs +++ b/library-internal/PostgresqlSyntax/Ast/FrameBound.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FrameClause.hs b/library-internal/PostgresqlSyntax/Ast/FrameClause.hs --- a/library-internal/PostgresqlSyntax/Ast/FrameClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/FrameClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FrameClauseMode.hs b/library-internal/PostgresqlSyntax/Ast/FrameClauseMode.hs --- a/library-internal/PostgresqlSyntax/Ast/FrameClauseMode.hs +++ b/library-internal/PostgresqlSyntax/Ast/FrameClauseMode.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FrameExtent.hs b/library-internal/PostgresqlSyntax/Ast/FrameExtent.hs --- a/library-internal/PostgresqlSyntax/Ast/FrameExtent.hs +++ b/library-internal/PostgresqlSyntax/Ast/FrameExtent.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FromClause.hs b/library-internal/PostgresqlSyntax/Ast/FromClause.hs --- a/library-internal/PostgresqlSyntax/Ast/FromClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/FromClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FromList.hs b/library-internal/PostgresqlSyntax/Ast/FromList.hs --- a/library-internal/PostgresqlSyntax/Ast/FromList.hs +++ b/library-internal/PostgresqlSyntax/Ast/FromList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncAliasClause.hs b/library-internal/PostgresqlSyntax/Ast/FuncAliasClause.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncAliasClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncAliasClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncApplication.hs b/library-internal/PostgresqlSyntax/Ast/FuncApplication.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncApplication.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncApplication.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncApplicationParams.hs b/library-internal/PostgresqlSyntax/Ast/FuncApplicationParams.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncApplicationParams.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncApplicationParams.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncArgExpr.hs b/library-internal/PostgresqlSyntax/Ast/FuncArgExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncArgExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncArgExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncConstArgs.hs b/library-internal/PostgresqlSyntax/Ast/FuncConstArgs.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncConstArgs.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncConstArgs.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncExpr.hs b/library-internal/PostgresqlSyntax/Ast/FuncExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs b/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs-boot b/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/FuncExprCommonSubexpr.hs-boot @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/FuncExprWindowless.hs b/library-internal/PostgresqlSyntax/Ast/FuncExprWindowless.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncExprWindowless.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncExprWindowless.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncName.hs b/library-internal/PostgresqlSyntax/Ast/FuncName.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncName.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncName.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/FuncTable.hs b/library-internal/PostgresqlSyntax/Ast/FuncTable.hs --- a/library-internal/PostgresqlSyntax/Ast/FuncTable.hs +++ b/library-internal/PostgresqlSyntax/Ast/FuncTable.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/GenericType.hs b/library-internal/PostgresqlSyntax/Ast/GenericType.hs --- a/library-internal/PostgresqlSyntax/Ast/GenericType.hs +++ b/library-internal/PostgresqlSyntax/Ast/GenericType.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/GroupByItem.hs b/library-internal/PostgresqlSyntax/Ast/GroupByItem.hs --- a/library-internal/PostgresqlSyntax/Ast/GroupByItem.hs +++ b/library-internal/PostgresqlSyntax/Ast/GroupByItem.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/GroupClause.hs b/library-internal/PostgresqlSyntax/Ast/GroupClause.hs --- a/library-internal/PostgresqlSyntax/Ast/GroupClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/GroupClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/HavingClause.hs b/library-internal/PostgresqlSyntax/Ast/HavingClause.hs --- a/library-internal/PostgresqlSyntax/Ast/HavingClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/HavingClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Iconst.hs b/library-internal/PostgresqlSyntax/Ast/Iconst.hs --- a/library-internal/PostgresqlSyntax/Ast/Iconst.hs +++ b/library-internal/PostgresqlSyntax/Ast/Iconst.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Ident.hs b/library-internal/PostgresqlSyntax/Ast/Ident.hs --- a/library-internal/PostgresqlSyntax/Ast/Ident.hs +++ b/library-internal/PostgresqlSyntax/Ast/Ident.hs @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/ImplicitRow.hs b/library-internal/PostgresqlSyntax/Ast/ImplicitRow.hs --- a/library-internal/PostgresqlSyntax/Ast/ImplicitRow.hs +++ b/library-internal/PostgresqlSyntax/Ast/ImplicitRow.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/InExpr.hs b/library-internal/PostgresqlSyntax/Ast/InExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/InExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/InExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/IndexElem.hs b/library-internal/PostgresqlSyntax/Ast/IndexElem.hs --- a/library-internal/PostgresqlSyntax/Ast/IndexElem.hs +++ b/library-internal/PostgresqlSyntax/Ast/IndexElem.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/IndexElemDef.hs b/library-internal/PostgresqlSyntax/Ast/IndexElemDef.hs --- a/library-internal/PostgresqlSyntax/Ast/IndexElemDef.hs +++ b/library-internal/PostgresqlSyntax/Ast/IndexElemDef.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/IndexParams.hs b/library-internal/PostgresqlSyntax/Ast/IndexParams.hs --- a/library-internal/PostgresqlSyntax/Ast/IndexParams.hs +++ b/library-internal/PostgresqlSyntax/Ast/IndexParams.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Indirection.hs b/library-internal/PostgresqlSyntax/Ast/Indirection.hs --- a/library-internal/PostgresqlSyntax/Ast/Indirection.hs +++ b/library-internal/PostgresqlSyntax/Ast/Indirection.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/IndirectionEl.hs b/library-internal/PostgresqlSyntax/Ast/IndirectionEl.hs --- a/library-internal/PostgresqlSyntax/Ast/IndirectionEl.hs +++ b/library-internal/PostgresqlSyntax/Ast/IndirectionEl.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/InsertColumnItem.hs b/library-internal/PostgresqlSyntax/Ast/InsertColumnItem.hs --- a/library-internal/PostgresqlSyntax/Ast/InsertColumnItem.hs +++ b/library-internal/PostgresqlSyntax/Ast/InsertColumnItem.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/InsertColumnList.hs b/library-internal/PostgresqlSyntax/Ast/InsertColumnList.hs --- a/library-internal/PostgresqlSyntax/Ast/InsertColumnList.hs +++ b/library-internal/PostgresqlSyntax/Ast/InsertColumnList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/InsertRest.hs b/library-internal/PostgresqlSyntax/Ast/InsertRest.hs --- a/library-internal/PostgresqlSyntax/Ast/InsertRest.hs +++ b/library-internal/PostgresqlSyntax/Ast/InsertRest.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/InsertStmt.hs b/library-internal/PostgresqlSyntax/Ast/InsertStmt.hs --- a/library-internal/PostgresqlSyntax/Ast/InsertStmt.hs +++ b/library-internal/PostgresqlSyntax/Ast/InsertStmt.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/InsertTarget.hs b/library-internal/PostgresqlSyntax/Ast/InsertTarget.hs --- a/library-internal/PostgresqlSyntax/Ast/InsertTarget.hs +++ b/library-internal/PostgresqlSyntax/Ast/InsertTarget.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Interval.hs b/library-internal/PostgresqlSyntax/Ast/Interval.hs --- a/library-internal/PostgresqlSyntax/Ast/Interval.hs +++ b/library-internal/PostgresqlSyntax/Ast/Interval.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/IntervalSecond.hs b/library-internal/PostgresqlSyntax/Ast/IntervalSecond.hs --- a/library-internal/PostgresqlSyntax/Ast/IntervalSecond.hs +++ b/library-internal/PostgresqlSyntax/Ast/IntervalSecond.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/IntoClause.hs b/library-internal/PostgresqlSyntax/Ast/IntoClause.hs --- a/library-internal/PostgresqlSyntax/Ast/IntoClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/IntoClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/JoinMeth.hs b/library-internal/PostgresqlSyntax/Ast/JoinMeth.hs deleted file mode 100644 --- a/library-internal/PostgresqlSyntax/Ast/JoinMeth.hs +++ /dev/null @@ -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 - ] diff --git a/library-internal/PostgresqlSyntax/Ast/JoinQual.hs b/library-internal/PostgresqlSyntax/Ast/JoinQual.hs --- a/library-internal/PostgresqlSyntax/Ast/JoinQual.hs +++ b/library-internal/PostgresqlSyntax/Ast/JoinQual.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/JoinType.hs b/library-internal/PostgresqlSyntax/Ast/JoinType.hs --- a/library-internal/PostgresqlSyntax/Ast/JoinType.hs +++ b/library-internal/PostgresqlSyntax/Ast/JoinType.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs b/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs --- a/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs +++ b/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs @@ -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" diff --git a/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs-boot b/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/JoinedTable.hs-boot @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/LimitClause.hs b/library-internal/PostgresqlSyntax/Ast/LimitClause.hs --- a/library-internal/PostgresqlSyntax/Ast/LimitClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/LimitClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/MathOp.hs b/library-internal/PostgresqlSyntax/Ast/MathOp.hs --- a/library-internal/PostgresqlSyntax/Ast/MathOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/MathOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/NameList.hs b/library-internal/PostgresqlSyntax/Ast/NameList.hs --- a/library-internal/PostgresqlSyntax/Ast/NameList.hs +++ b/library-internal/PostgresqlSyntax/Ast/NameList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/NullsOrder.hs b/library-internal/PostgresqlSyntax/Ast/NullsOrder.hs --- a/library-internal/PostgresqlSyntax/Ast/NullsOrder.hs +++ b/library-internal/PostgresqlSyntax/Ast/NullsOrder.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Numeric.hs b/library-internal/PostgresqlSyntax/Ast/Numeric.hs --- a/library-internal/PostgresqlSyntax/Ast/Numeric.hs +++ b/library-internal/PostgresqlSyntax/Ast/Numeric.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OffsetClause.hs b/library-internal/PostgresqlSyntax/Ast/OffsetClause.hs --- a/library-internal/PostgresqlSyntax/Ast/OffsetClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/OffsetClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OnConflict.hs b/library-internal/PostgresqlSyntax/Ast/OnConflict.hs --- a/library-internal/PostgresqlSyntax/Ast/OnConflict.hs +++ b/library-internal/PostgresqlSyntax/Ast/OnConflict.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OnConflictDo.hs b/library-internal/PostgresqlSyntax/Ast/OnConflictDo.hs --- a/library-internal/PostgresqlSyntax/Ast/OnConflictDo.hs +++ b/library-internal/PostgresqlSyntax/Ast/OnConflictDo.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Op.hs b/library-internal/PostgresqlSyntax/Ast/Op.hs --- a/library-internal/PostgresqlSyntax/Ast/Op.hs +++ b/library-internal/PostgresqlSyntax/Ast/Op.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OptOrdinality.hs b/library-internal/PostgresqlSyntax/Ast/OptOrdinality.hs --- a/library-internal/PostgresqlSyntax/Ast/OptOrdinality.hs +++ b/library-internal/PostgresqlSyntax/Ast/OptOrdinality.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OptTempTableName.hs b/library-internal/PostgresqlSyntax/Ast/OptTempTableName.hs --- a/library-internal/PostgresqlSyntax/Ast/OptTempTableName.hs +++ b/library-internal/PostgresqlSyntax/Ast/OptTempTableName.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OptVarying.hs b/library-internal/PostgresqlSyntax/Ast/OptVarying.hs --- a/library-internal/PostgresqlSyntax/Ast/OptVarying.hs +++ b/library-internal/PostgresqlSyntax/Ast/OptVarying.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OverClause.hs b/library-internal/PostgresqlSyntax/Ast/OverClause.hs --- a/library-internal/PostgresqlSyntax/Ast/OverClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/OverClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OverlayList.hs b/library-internal/PostgresqlSyntax/Ast/OverlayList.hs --- a/library-internal/PostgresqlSyntax/Ast/OverlayList.hs +++ b/library-internal/PostgresqlSyntax/Ast/OverlayList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/OverrideKind.hs b/library-internal/PostgresqlSyntax/Ast/OverrideKind.hs --- a/library-internal/PostgresqlSyntax/Ast/OverrideKind.hs +++ b/library-internal/PostgresqlSyntax/Ast/OverrideKind.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/PositionList.hs b/library-internal/PostgresqlSyntax/Ast/PositionList.hs --- a/library-internal/PostgresqlSyntax/Ast/PositionList.hs +++ b/library-internal/PostgresqlSyntax/Ast/PositionList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/PreparableStmt.hs b/library-internal/PostgresqlSyntax/Ast/PreparableStmt.hs --- a/library-internal/PostgresqlSyntax/Ast/PreparableStmt.hs +++ b/library-internal/PostgresqlSyntax/Ast/PreparableStmt.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/QualAllOp.hs b/library-internal/PostgresqlSyntax/Ast/QualAllOp.hs --- a/library-internal/PostgresqlSyntax/Ast/QualAllOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/QualAllOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/QualOp.hs b/library-internal/PostgresqlSyntax/Ast/QualOp.hs --- a/library-internal/PostgresqlSyntax/Ast/QualOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/QualOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/QualifiedName.hs b/library-internal/PostgresqlSyntax/Ast/QualifiedName.hs --- a/library-internal/PostgresqlSyntax/Ast/QualifiedName.hs +++ b/library-internal/PostgresqlSyntax/Ast/QualifiedName.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/RelationExpr.hs b/library-internal/PostgresqlSyntax/Ast/RelationExpr.hs --- a/library-internal/PostgresqlSyntax/Ast/RelationExpr.hs +++ b/library-internal/PostgresqlSyntax/Ast/RelationExpr.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/RelationExprOptAlias.hs b/library-internal/PostgresqlSyntax/Ast/RelationExprOptAlias.hs --- a/library-internal/PostgresqlSyntax/Ast/RelationExprOptAlias.hs +++ b/library-internal/PostgresqlSyntax/Ast/RelationExprOptAlias.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ReturningClause.hs b/library-internal/PostgresqlSyntax/Ast/ReturningClause.hs --- a/library-internal/PostgresqlSyntax/Ast/ReturningClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/ReturningClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Row.hs b/library-internal/PostgresqlSyntax/Ast/Row.hs --- a/library-internal/PostgresqlSyntax/Ast/Row.hs +++ b/library-internal/PostgresqlSyntax/Ast/Row.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/RowsfromItem.hs b/library-internal/PostgresqlSyntax/Ast/RowsfromItem.hs --- a/library-internal/PostgresqlSyntax/Ast/RowsfromItem.hs +++ b/library-internal/PostgresqlSyntax/Ast/RowsfromItem.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/RowsfromList.hs b/library-internal/PostgresqlSyntax/Ast/RowsfromList.hs --- a/library-internal/PostgresqlSyntax/Ast/RowsfromList.hs +++ b/library-internal/PostgresqlSyntax/Ast/RowsfromList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Sconst.hs b/library-internal/PostgresqlSyntax/Ast/Sconst.hs --- a/library-internal/PostgresqlSyntax/Ast/Sconst.hs +++ b/library-internal/PostgresqlSyntax/Ast/Sconst.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectBinOp.hs b/library-internal/PostgresqlSyntax/Ast/SelectBinOp.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectBinOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectBinOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectClause.hs b/library-internal/PostgresqlSyntax/Ast/SelectClause.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectClause.hs-boot b/library-internal/PostgresqlSyntax/Ast/SelectClause.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/SelectClause.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/SelectClause.hs-boot @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/SelectFetchFirstValue.hs b/library-internal/PostgresqlSyntax/Ast/SelectFetchFirstValue.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectFetchFirstValue.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectFetchFirstValue.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectLimit.hs b/library-internal/PostgresqlSyntax/Ast/SelectLimit.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectLimit.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectLimit.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectLimitValue.hs b/library-internal/PostgresqlSyntax/Ast/SelectLimitValue.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectLimitValue.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectLimitValue.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs b/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs-boot b/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/SelectNoParens.hs-boot @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectStmt.hs b/library-internal/PostgresqlSyntax/Ast/SelectStmt.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectStmt.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectStmt.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs b/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs --- a/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs +++ b/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs-boot b/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/SelectWithParens.hs-boot @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SetClause.hs b/library-internal/PostgresqlSyntax/Ast/SetClause.hs --- a/library-internal/PostgresqlSyntax/Ast/SetClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/SetClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SetClauseList.hs b/library-internal/PostgresqlSyntax/Ast/SetClauseList.hs --- a/library-internal/PostgresqlSyntax/Ast/SetClauseList.hs +++ b/library-internal/PostgresqlSyntax/Ast/SetClauseList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SetTarget.hs b/library-internal/PostgresqlSyntax/Ast/SetTarget.hs --- a/library-internal/PostgresqlSyntax/Ast/SetTarget.hs +++ b/library-internal/PostgresqlSyntax/Ast/SetTarget.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SetTargetList.hs b/library-internal/PostgresqlSyntax/Ast/SetTargetList.hs --- a/library-internal/PostgresqlSyntax/Ast/SetTargetList.hs +++ b/library-internal/PostgresqlSyntax/Ast/SetTargetList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs b/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs --- a/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs +++ b/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs @@ -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, []) diff --git a/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs-boot b/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/SimpleSelect.hs-boot @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SimpleTypename.hs b/library-internal/PostgresqlSyntax/Ast/SimpleTypename.hs --- a/library-internal/PostgresqlSyntax/Ast/SimpleTypename.hs +++ b/library-internal/PostgresqlSyntax/Ast/SimpleTypename.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SortBy.hs b/library-internal/PostgresqlSyntax/Ast/SortBy.hs --- a/library-internal/PostgresqlSyntax/Ast/SortBy.hs +++ b/library-internal/PostgresqlSyntax/Ast/SortBy.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SortClause.hs b/library-internal/PostgresqlSyntax/Ast/SortClause.hs --- a/library-internal/PostgresqlSyntax/Ast/SortClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/SortClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SubType.hs b/library-internal/PostgresqlSyntax/Ast/SubType.hs --- a/library-internal/PostgresqlSyntax/Ast/SubType.hs +++ b/library-internal/PostgresqlSyntax/Ast/SubType.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SubqueryOp.hs b/library-internal/PostgresqlSyntax/Ast/SubqueryOp.hs --- a/library-internal/PostgresqlSyntax/Ast/SubqueryOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/SubqueryOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SubstrList.hs b/library-internal/PostgresqlSyntax/Ast/SubstrList.hs --- a/library-internal/PostgresqlSyntax/Ast/SubstrList.hs +++ b/library-internal/PostgresqlSyntax/Ast/SubstrList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SubstrListFromFor.hs b/library-internal/PostgresqlSyntax/Ast/SubstrListFromFor.hs --- a/library-internal/PostgresqlSyntax/Ast/SubstrListFromFor.hs +++ b/library-internal/PostgresqlSyntax/Ast/SubstrListFromFor.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/SymbolicExprBinOp.hs b/library-internal/PostgresqlSyntax/Ast/SymbolicExprBinOp.hs --- a/library-internal/PostgresqlSyntax/Ast/SymbolicExprBinOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/SymbolicExprBinOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TableFuncElement.hs b/library-internal/PostgresqlSyntax/Ast/TableFuncElement.hs --- a/library-internal/PostgresqlSyntax/Ast/TableFuncElement.hs +++ b/library-internal/PostgresqlSyntax/Ast/TableFuncElement.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TableFuncElementList.hs b/library-internal/PostgresqlSyntax/Ast/TableFuncElementList.hs --- a/library-internal/PostgresqlSyntax/Ast/TableFuncElementList.hs +++ b/library-internal/PostgresqlSyntax/Ast/TableFuncElementList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TableRef.hs b/library-internal/PostgresqlSyntax/Ast/TableRef.hs --- a/library-internal/PostgresqlSyntax/Ast/TableRef.hs +++ b/library-internal/PostgresqlSyntax/Ast/TableRef.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TableRef.hs-boot b/library-internal/PostgresqlSyntax/Ast/TableRef.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/TableRef.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/TableRef.hs-boot @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TablesampleClause.hs b/library-internal/PostgresqlSyntax/Ast/TablesampleClause.hs --- a/library-internal/PostgresqlSyntax/Ast/TablesampleClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/TablesampleClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TargetEl.hs b/library-internal/PostgresqlSyntax/Ast/TargetEl.hs --- a/library-internal/PostgresqlSyntax/Ast/TargetEl.hs +++ b/library-internal/PostgresqlSyntax/Ast/TargetEl.hs @@ -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 ] diff --git a/library-internal/PostgresqlSyntax/Ast/TargetList.hs b/library-internal/PostgresqlSyntax/Ast/TargetList.hs --- a/library-internal/PostgresqlSyntax/Ast/TargetList.hs +++ b/library-internal/PostgresqlSyntax/Ast/TargetList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Targeting.hs b/library-internal/PostgresqlSyntax/Ast/Targeting.hs --- a/library-internal/PostgresqlSyntax/Ast/Targeting.hs +++ b/library-internal/PostgresqlSyntax/Ast/Targeting.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Timezone.hs b/library-internal/PostgresqlSyntax/Ast/Timezone.hs --- a/library-internal/PostgresqlSyntax/Ast/Timezone.hs +++ b/library-internal/PostgresqlSyntax/Ast/Timezone.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TrimList.hs b/library-internal/PostgresqlSyntax/Ast/TrimList.hs --- a/library-internal/PostgresqlSyntax/Ast/TrimList.hs +++ b/library-internal/PostgresqlSyntax/Ast/TrimList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TrimModifier.hs b/library-internal/PostgresqlSyntax/Ast/TrimModifier.hs --- a/library-internal/PostgresqlSyntax/Ast/TrimModifier.hs +++ b/library-internal/PostgresqlSyntax/Ast/TrimModifier.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TypeList.hs b/library-internal/PostgresqlSyntax/Ast/TypeList.hs --- a/library-internal/PostgresqlSyntax/Ast/TypeList.hs +++ b/library-internal/PostgresqlSyntax/Ast/TypeList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/Typename.hs b/library-internal/PostgresqlSyntax/Ast/Typename.hs --- a/library-internal/PostgresqlSyntax/Ast/Typename.hs +++ b/library-internal/PostgresqlSyntax/Ast/Typename.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/TypenameArrayDimensions.hs b/library-internal/PostgresqlSyntax/Ast/TypenameArrayDimensions.hs --- a/library-internal/PostgresqlSyntax/Ast/TypenameArrayDimensions.hs +++ b/library-internal/PostgresqlSyntax/Ast/TypenameArrayDimensions.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/UpdateStmt.hs b/library-internal/PostgresqlSyntax/Ast/UpdateStmt.hs --- a/library-internal/PostgresqlSyntax/Ast/UpdateStmt.hs +++ b/library-internal/PostgresqlSyntax/Ast/UpdateStmt.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/UsingClause.hs b/library-internal/PostgresqlSyntax/Ast/UsingClause.hs --- a/library-internal/PostgresqlSyntax/Ast/UsingClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/UsingClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/ValuesClause.hs b/library-internal/PostgresqlSyntax/Ast/ValuesClause.hs --- a/library-internal/PostgresqlSyntax/Ast/ValuesClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/ValuesClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/VerbalExprBinOp.hs b/library-internal/PostgresqlSyntax/Ast/VerbalExprBinOp.hs --- a/library-internal/PostgresqlSyntax/Ast/VerbalExprBinOp.hs +++ b/library-internal/PostgresqlSyntax/Ast/VerbalExprBinOp.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WhenClause.hs b/library-internal/PostgresqlSyntax/Ast/WhenClause.hs --- a/library-internal/PostgresqlSyntax/Ast/WhenClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/WhenClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WhenClauseList.hs b/library-internal/PostgresqlSyntax/Ast/WhenClauseList.hs --- a/library-internal/PostgresqlSyntax/Ast/WhenClauseList.hs +++ b/library-internal/PostgresqlSyntax/Ast/WhenClauseList.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WhereClause.hs b/library-internal/PostgresqlSyntax/Ast/WhereClause.hs --- a/library-internal/PostgresqlSyntax/Ast/WhereClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/WhereClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WhereOrCurrentClause.hs b/library-internal/PostgresqlSyntax/Ast/WhereOrCurrentClause.hs --- a/library-internal/PostgresqlSyntax/Ast/WhereOrCurrentClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/WhereOrCurrentClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WindowClause.hs b/library-internal/PostgresqlSyntax/Ast/WindowClause.hs --- a/library-internal/PostgresqlSyntax/Ast/WindowClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/WindowClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WindowDefinition.hs b/library-internal/PostgresqlSyntax/Ast/WindowDefinition.hs --- a/library-internal/PostgresqlSyntax/Ast/WindowDefinition.hs +++ b/library-internal/PostgresqlSyntax/Ast/WindowDefinition.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WindowExclusionClause.hs b/library-internal/PostgresqlSyntax/Ast/WindowExclusionClause.hs --- a/library-internal/PostgresqlSyntax/Ast/WindowExclusionClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/WindowExclusionClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WindowSpecification.hs b/library-internal/PostgresqlSyntax/Ast/WindowSpecification.hs --- a/library-internal/PostgresqlSyntax/Ast/WindowSpecification.hs +++ b/library-internal/PostgresqlSyntax/Ast/WindowSpecification.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WithClause.hs b/library-internal/PostgresqlSyntax/Ast/WithClause.hs --- a/library-internal/PostgresqlSyntax/Ast/WithClause.hs +++ b/library-internal/PostgresqlSyntax/Ast/WithClause.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Ast/WithClause.hs-boot b/library-internal/PostgresqlSyntax/Ast/WithClause.hs-boot --- a/library-internal/PostgresqlSyntax/Ast/WithClause.hs-boot +++ b/library-internal/PostgresqlSyntax/Ast/WithClause.hs-boot @@ -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) diff --git a/library-internal/PostgresqlSyntax/Ast/Xconst.hs b/library-internal/PostgresqlSyntax/Ast/Xconst.hs --- a/library-internal/PostgresqlSyntax/Ast/Xconst.hs +++ b/library-internal/PostgresqlSyntax/Ast/Xconst.hs @@ -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 diff --git a/library-internal/PostgresqlSyntax/Helpers/Parsers.hs b/library-internal/PostgresqlSyntax/Helpers/Parsers.hs --- a/library-internal/PostgresqlSyntax/Helpers/Parsers.hs +++ b/library-internal/PostgresqlSyntax/Helpers/Parsers.hs @@ -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" $ diff --git a/library-internal/PostgresqlSyntax/IsAst.hs b/library-internal/PostgresqlSyntax/IsAst.hs deleted file mode 100644 --- a/library-internal/PostgresqlSyntax/IsAst.hs +++ /dev/null @@ -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)) diff --git a/library-internal/PostgresqlSyntax/Prelude.hs b/library-internal/PostgresqlSyntax/Prelude.hs --- a/library-internal/PostgresqlSyntax/Prelude.hs +++ b/library-internal/PostgresqlSyntax/Prelude.hs @@ -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. diff --git a/library-internal/PostgresqlSyntax/Settings.hs b/library-internal/PostgresqlSyntax/Settings.hs --- a/library-internal/PostgresqlSyntax/Settings.hs +++ b/library-internal/PostgresqlSyntax/Settings.hs @@ -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) diff --git a/library/PostgresqlSyntax.hs b/library/PostgresqlSyntax.hs --- a/library/PostgresqlSyntax.hs +++ b/library/PostgresqlSyntax.hs @@ -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 diff --git a/nesting-bench/Main.hs b/nesting-bench/Main.hs --- a/nesting-bench/Main.hs +++ b/nesting-bench/Main.hs @@ -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 diff --git a/postgresql-syntax.cabal b/postgresql-syntax.cabal --- a/postgresql-syntax.cabal +++ b/postgresql-syntax.cabal @@ -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