packages feed

postgresql-syntax 0.5.0.1 → 0.5.0.2

raw patch · 197 files changed

+1028/−914 lines, 197 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

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