From b00acbe182f64e68f232826f7f8b5afb514a5eb6 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Mon, 12 Feb 2024 10:46:38 -0800
Subject: [PATCH] Add parens to annotation of lexed symboly segments

---
 unison-src/transcripts/formatter.md        |  9 +++++++++
 unison-src/transcripts/formatter.output.md | 16 ++++++++++++++++
 unison-syntax/src/Unison/Syntax/Parser.hs  | 12 ++++++++++--
 3 files changed, 35 insertions(+), 2 deletions(-)

diff --git a/unison-src/transcripts/formatter.md b/unison-src/transcripts/formatter.md
index 951153a75a..d360a8bb84 100644
--- a/unison-src/transcripts/formatter.md
+++ b/unison-src/transcripts/formatter.md
@@ -19,6 +19,15 @@ x y =
     x + y
 -- Should keep comments after
 
+-- symbolyDefinition
+(<|>) : Nat -> Nat -> (Nat, Nat)
+(<|>) a b = (a, b)
+
+symbolyEndOfBlock =
+  use List +:
+  (+:)
+
+
 -- Test for a previous regression that added extra brackets.
 oneLiner = {{ one liner }}
 -- After
diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md
index 5238f92e3f..c2199ac3df 100644
--- a/unison-src/transcripts/formatter.output.md
+++ b/unison-src/transcripts/formatter.output.md
@@ -15,6 +15,15 @@ x y =
     x + y
 -- Should keep comments after
 
+-- symbolyDefinition
+(<|>) : Nat -> Nat -> (Nat, Nat)
+(<|>) a b = (a, b)
+
+f x y =
+  use List +:
+  (+:)
+
+
 -- Test for a previous regression that added extra brackets.
 oneLiner = {{ one liner }}
 -- After
@@ -94,6 +103,13 @@ x y =
   x + y
 -- Should keep comments after
 
+-- symbolyDefinition
+(<|>) : Nat -> Nat -> (Nat, Nat)
+a <|> b = (a, b)
+
+f x y = (+:)
+
+
 -- Test for a previous regression that added extra brackets.
 oneLiner = {{ one liner }}
 -- After
diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs
index be115a6a92..e8645f715b 100644
--- a/unison-syntax/src/Unison/Syntax/Parser.hs
+++ b/unison-syntax/src/Unison/Syntax/Parser.hs
@@ -338,8 +338,16 @@ symbolyDefinitionName = queryToken $ \case
   L.SymbolyId n -> Just $ Name.toVar (HQ'.toName n)
   _ -> Nothing
 
-parenthesize :: (Ord v) => P v m a -> P v m a
-parenthesize p = P.try (openBlockWith "(" *> p) <* closeBlock
+-- | Expect parentheses around a token, includes the parentheses within the start/end
+-- annotations of the resulting token.
+parenthesize :: (Ord v) => P v m (L.Token a) -> P v m (L.Token a)
+parenthesize p = do
+  (start, a) <- P.try do
+    start <- L.start <$> openBlockWith "("
+    a <- p
+    pure (start, a)
+  end <- L.end <$> closeBlock
+  pure (L.Token {payload = L.payload a, start, end})
 
 hqPrefixId, hqInfixId :: (Ord v) => P v m (L.Token (HQ.HashQualified Name))
 hqPrefixId = hqWordyId_ <|> parenthesize hqSymbolyId_