postgresql-syntax 0.4.3.1 → 0.4.3.2

raw patch · 5 files changed

+166/−7 lines, 5 filesdep +containersdep +criteriondep ~rerebasePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers, criterion

Dependency ranges changed: rerebase

API changes (from Hackage documentation)

Files

• bench/Main.hs +116/−0
• hedgehog-test/Main/Gen.hs +1/−3
• library/PostgresqlSyntax/Parsing.hs +28/−2
• postgresql-syntax.cabal +20/−1
• tasty-test/Main.hs +1/−1

@@ -0,0 +1,116 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}++-- |+-- Benchmark for the "keyword allocation cost in wide alternations" concern+-- raised in <https://github.com/nikita-volkov/postgresql-syntax/issues/21>.+--+-- Compares the shipped, cheap 'PostgresqlSyntax.Parsing.keyword'+-- (a bare 'empty' on mismatch, no allocation beyond the consumed text)+-- against a richer alternative that reports a proper \"expected one of ...\"+-- error via 'Text.Megaparsec.failure' (as PR #20 proposed), the way it would+-- behave sitting inside a wide 'asum'\/'choice' of keyword alternatives.+--+-- Both implementations here pin the reported error offset via+-- 'Megaparsec.setOffset', matching the fix applied to the shipped+-- 'PostgresqlSyntax.Parsing.keyword' to stay correct under megaparsec+-- >=9.8's stricter '(<|>)' error-merging. That fix is what makes the rich+-- variant produce complete "expecting ..." lists at all under current+-- megaparsec; see 'PostgresqlSyntax.Parsing.keyword''s haddock.+module Main where++import Criterion.Main+import qualified Data.Char as Char+import qualified Data.HashSet as HashSet+import qualified Data.Set as Set+import qualified Data.Text as Text+import HeadedMegaparsec (HeadedParsec, parse, toParsec)+import qualified Hedgehog.Gen as Gen+import qualified Main.Gen as SynGen+import qualified PostgresqlSyntax.KeywordSet as KeywordSet+import qualified PostgresqlSyntax.Parsing as Parsing+import qualified PostgresqlSyntax.Rendering as Rendering+import qualified Text.Megaparsec as Megaparsec+import Prelude++-- * Shared token scanner (mirrors 'PostgresqlSyntax.Parsing.anyKeyword')++firstIdentifierChar :: Char -> Bool+firstIdentifierChar x = Char.isAlpha x || x == '_' || x >= '\200' && x <= '\377'++notFirstIdentifierChar :: Char -> Bool+notFirstIdentifierChar x = Char.isAlphaNum x || x == '_' || x == '$' || x >= '\200' && x <= '\377'++anyKeywordRaw :: Megaparsec.Parsec Void Text.Text Text.Text+anyKeywordRaw =+  Megaparsec.label "keyword" $ do+    firstChar <- Megaparsec.satisfy firstIdentifierChar+    remainder <- Megaparsec.takeWhileP Nothing notFirstIdentifierChar+    return (Text.toLower (Text.cons firstChar remainder))++-- * The two candidate implementations++-- | Shipped implementation: fails with a bare, unlabeled 'empty' on mismatch.+cheapKeyword :: Text.Text -> HeadedParsec Void Text.Text Text.Text+cheapKeyword expected = parse $ do+  off <- Megaparsec.getOffset+  parsed <- anyKeywordRaw+  if expected == parsed then return parsed else Megaparsec.setOffset off *> empty++-- | PR #20-style implementation: fails with an explicit chunk expectation,+-- so failed alternatives can be unioned into a readable "expecting one of+-- ..." message. Allocates a 'NonEmpty' 'Char' and a 'Set' per failed branch.+richKeyword :: Text.Text -> HeadedParsec Void Text.Text Text.Text+richKeyword expected = parse $ do+  off <- Megaparsec.getOffset+  parsed <- anyKeywordRaw+  if expected == parsed then return parsed else Megaparsec.setOffset off *> chunkFailure expected parsed+  where+    chunkFailure expectedTxt givenTxt =+      Megaparsec.failure+        (Just (errorItemConverter givenTxt))+        (Set.fromList (pure (errorItemConverter expectedTxt)))+    errorItemConverter t = Megaparsec.Tokens $ case Text.uncons t of+      Just (h, rest) -> h :| Text.unpack rest+      Nothing -> ' ' :| []++runHeaded :: HeadedParsec Void Text.Text a -> Text.Text -> Either (Megaparsec.ParseErrorBundle Text.Text Void) a+runHeaded p = Megaparsec.runParser (toParsec p <* Megaparsec.eof) ""++-- * Wide-alternation scenarios++-- | An alternation over every element of the given keyword list, dispatched+-- via the given per-keyword implementation. This is the shape 'keyword'+-- actually sits in throughout the grammar: many 'HeadedParsec' alternatives+-- tried in sequence via '(<|>)'\/'asum'.+wideAlternation :: (Text.Text -> HeadedParsec Void Text.Text Text.Text) -> [Text.Text] -> HeadedParsec Void Text.Text Text.Text+wideAlternation impl kws = asum (map impl kws)++main :: IO ()+main = do+  let reservedWords = HashSet.toList KeywordSet.reservedKeyword -- ~90 words: the size of a typical mid-size dispatch+      allWords = HashSet.toList KeywordSet.keyword -- ~440 words: the full reserved-word set, worst case+      lastOf xs = last xs+      noMatchToken = "zzzznotakeyword" :: Text.Text++  corpus <- replicateM 500 (Gen.sample (Gen.resize 15 SynGen.preparableStmt))+  let corpusTexts = map (Rendering.toText . Rendering.preparableStmt) corpus++  defaultMain+    [ bgroup+        "keyword in wide alternation"+        [ bgroup+            (label <> ", " <> scenario)+            [ bench "cheap" $ whnf (runHeaded (wideAlternation cheapKeyword kws)) token,+              bench "rich" $ whnf (runHeaded (wideAlternation richKeyword kws)) token+            ]+        | (label, kws) <- [("~90 words", reservedWords), ("~440 words", allWords)],+          (scenario, token) <-+            [ ("first match", head kws),+              ("last match", lastOf kws),+              ("no match", noMatchToken)+            ]+        ],+      bgroup+        "full grammar on generated corpus (reference, shipped keyword only)"+        [bench "500 generated preparableStmt" $ nf (map (either (const False) (const True) . Parsing.run Parsing.preparableStmt)) corpusTexts]+    ]

@@ -879,8 +879,6 @@  ident = identWithSet mempty -typeName = identWithSet KeywordSet.typeFunctionName- name = identWithSet KeywordSet.colId  cursorName = name@@ -915,7 +913,7 @@  attrName = colLabel -typeFunctionName = name+typeFunctionName = identWithSet KeywordSet.typeFunctionName  funcName =   choice

@@ -1367,7 +1367,14 @@       ExprListTrimList <$> exprList     ] -funcApplication = inParensWithLabel FuncApplication funcName (optional funcApplicationParams)+-- |+-- \"operator\" immediately followed by \"(\" is always parsed as the start+-- of a qualified operator (@OPERATOR(...)@), never as a call to a function+-- literally named \"operator\", mirroring how real PostgreSQL's grammar+-- resolves the conflict between these two productions in favor of qual_op.+funcApplication =+  notFollowedBy (keyword "operator" *> space *> char '(')+    *> inParensWithLabel FuncApplication funcName (optional funcApplicationParams)  funcApplicationParams =   asum@@ -2031,7 +2038,26 @@     return (Text.toLower (Text.cons firstChar remainder))  -- | Expected keyword-keyword a = mfilter (a ==) anyKeyword+--+-- Wraps the head in 'Megaparsec.region' to pin the reported error offset to+-- where this keyword check began. Without this, megaparsec >=9.8's stricter+-- (and correct) '(<|>)' error-merging (fix for+-- <https://github.com/mrkkrp/megaparsec/issues/412>) normalizes any error+-- whose offset lands past the enclosing alternative's start back down to+-- that start, discarding its \"expecting\" set unless the offset already+-- matches exactly. Since every failed keyword branch consumes some+-- identifier text before comparing, its offset always landed past the+-- alternative's start, so wide 'asum'/'choice' chains of 'keyword' lost+-- their combined expected-token sets under 9.8. Pinning the offset up front+-- keeps every branch's offset aligned with the alternative's start, so+-- their expected sets still union correctly.+keyword a = parse $ do+  off <- Megaparsec.getOffset+  Megaparsec.region (Megaparsec.setErrorOffset off) $ do+    firstChar <- Megaparsec.satisfy Predicate.firstIdentifierChar+    remainder <- Megaparsec.takeWhileP Nothing Predicate.notFirstIdentifierChar+    let parsedKeyword = Text.toLower (Text.cons firstChar remainder)+    if a == parsedKeyword then return parsedKeyword else empty  -- | -- Consume a keyphrase, ignoring case and types of spaces between words.

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-syntax-version: 0.4.3.1+version: 0.4.3.2 category: Database, PostgreSQL, Parsing synopsis: PostgreSQL AST parsing and rendering description:@@ -114,5 +114,24 @@   other-modules: Main.Gen   build-depends:     hedgehog >=1.0.1 && <2,+    postgresql-syntax,+    rerebase >=1.6.1 && <2,++benchmark keyword-bench+  import: base-settings+  type: exitcode-stdio-1.0+  hs-source-dirs:+    bench+    hedgehog-test++  main-is: Main.hs+  ghc-options: -O2+  other-modules: Main.Gen+  build-depends:+    containers >=0.4 && <1,+    criterion >=1.6 && <1.7,+    headed-megaparsec >=0.2.0.1 && <0.3,+    hedgehog >=1.0.1 && <2,+    megaparsec >=9.2 && <10,     postgresql-syntax,     rerebase >=1.6.1 && <2,

@@ -99,6 +99,6 @@                     [ "select i :: int8 from auth.user as u\n\                       \WHERE u.id IS NO NULL && TRUE"                     ]-                    "(53,\"offset=53:\\nexpecting white space\\n\")"+                    "(51,\"offset=51:\\nexpecting white space\\n\")"                 ]       ]