From bbbca4f3402f3446e39ebd71b7b757399984e41f Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Mon, 2 Oct 2023 18:34:58 +0300
Subject: [PATCH] Resolve #9098: Add LexBraces lexer warning (#9099)

---
 .../src/Distribution/Fields/LexerMonad.hs      | 15 ++++++++++-----
 Cabal-syntax/src/Distribution/Fields/Parser.hs | 14 +++++++++++---
 changelog.d/issue-9098-lexbraces               | 18 ++++++++++++++++++
 3 files changed, 39 insertions(+), 8 deletions(-)
 create mode 100644 changelog.d/issue-9098-lexbraces

diff --git a/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs b/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs
index 782b8a2406..601a1d579f 100644
--- a/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs
+++ b/Cabal-syntax/src/Distribution/Fields/LexerMonad.hs
@@ -69,6 +69,8 @@ data LexWarningType
     LexWarningTab
   | -- | indentation decreases
     LexInconsistentIndentation
+  | -- | Brace syntax used
+    LexBraces
   deriving (Eq, Ord, Show)
 
 data LexWarning
@@ -79,19 +81,22 @@ data LexWarning
 
 toPWarnings :: [LexWarning] -> [PWarning]
 toPWarnings =
-  map (uncurry toWarning)
+  mapMaybe (uncurry toWarning)
     . Map.toList
     . Map.fromListWith (flip (<>)) -- fromListWith gives existing element first.
     . map (\(LexWarning t p) -> (t, pure p))
   where
     toWarning LexWarningBOM poss =
-      PWarning PWTLexBOM (NE.head poss) "Byte-order mark found at the beginning of the file"
+      Just $ PWarning PWTLexBOM (NE.head poss) "Byte-order mark found at the beginning of the file"
     toWarning LexWarningNBSP poss =
-      PWarning PWTLexNBSP (NE.head poss) $ "Non breaking spaces at " ++ intercalate ", " (NE.toList $ fmap showPos poss)
+      Just $ PWarning PWTLexNBSP (NE.head poss) $ "Non breaking spaces at " ++ intercalate ", " (NE.toList $ fmap showPos poss)
     toWarning LexWarningTab poss =
-      PWarning PWTLexTab (NE.head poss) $ "Tabs used as indentation at " ++ intercalate ", " (NE.toList $ fmap showPos poss)
+      Just $ PWarning PWTLexTab (NE.head poss) $ "Tabs used as indentation at " ++ intercalate ", " (NE.toList $ fmap showPos poss)
     toWarning LexInconsistentIndentation poss =
-      PWarning PWTInconsistentIndentation (NE.head poss) $ "Inconsistent indentation. Indentation jumps at lines " ++ intercalate ", " (NE.toList $ fmap (show . positionRow) poss)
+      Just $ PWarning PWTInconsistentIndentation (NE.head poss) $ "Inconsistent indentation. Indentation jumps at lines " ++ intercalate ", " (NE.toList $ fmap (show . positionRow) poss)
+    -- LexBraces warning about using { } delimeters is not reported as parser warning.
+    toWarning LexBraces _ =
+      Nothing
 
 {- FOURMOLU_DISABLE -}
 data LexState = LexState
diff --git a/Cabal-syntax/src/Distribution/Fields/Parser.hs b/Cabal-syntax/src/Distribution/Fields/Parser.hs
index bbbfeff169..91c11ff1a6 100644
--- a/Cabal-syntax/src/Distribution/Fields/Parser.hs
+++ b/Cabal-syntax/src/Distribution/Fields/Parser.hs
@@ -86,6 +86,11 @@ getLexerWarnings = do
   LexState' (LexState{warnings = ws}) _ <- getInput
   return ws
 
+addLexerWarning :: LexWarning -> Parser ()
+addLexerWarning w = do
+  LexState' ls@LexState{warnings = ws} _ <- getInput
+  setInput $! mkLexState' ls{warnings = w : ws}
+
 -- | Set Alex code i.e. the mode "state" lexer is in.
 setLexerMode :: Int -> Parser ()
 setLexerMode code = do
@@ -118,7 +123,8 @@ describeToken t = case t of
 tokSym :: Parser (Name Position)
 tokSym', tokStr, tokOther :: Parser (SectionArg Position)
 tokIndent :: Parser Int
-tokColon, tokOpenBrace, tokCloseBrace :: Parser ()
+tokColon, tokCloseBrace :: Parser ()
+tokOpenBrace :: Parser Position
 tokFieldLine :: Parser (FieldLine Position)
 tokSym = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (mkName pos x); _ -> Nothing
 tokSym' = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (SecArgName pos x); _ -> Nothing
@@ -126,7 +132,7 @@ tokStr = getTokenWithPos $ \t -> case t of L pos (TokStr x) -> Just (SecArgStr p
 tokOther = getTokenWithPos $ \t -> case t of L pos (TokOther x) -> Just (SecArgOther pos x); _ -> Nothing
 tokIndent = getToken $ \t -> case t of Indent x -> Just x; _ -> Nothing
 tokColon = getToken $ \t -> case t of Colon -> Just (); _ -> Nothing
-tokOpenBrace = getToken $ \t -> case t of OpenBrace -> Just (); _ -> Nothing
+tokOpenBrace = getTokenWithPos $ \t -> case t of L pos OpenBrace -> Just pos; _ -> Nothing
 tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing
 tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing
 
@@ -138,7 +144,9 @@ fieldSecName :: Parser (Name Position)
 fieldSecName = tokSym <?> "field or section name"
 
 colon = tokColon <?> "\":\""
-openBrace = tokOpenBrace <?> "\"{\""
+openBrace = do
+  pos <- tokOpenBrace <?> "\"{\""
+  addLexerWarning (LexWarning LexBraces pos)
 closeBrace = tokCloseBrace <?> "\"}\""
 
 fieldContent :: Parser (FieldLine Position)
diff --git a/changelog.d/issue-9098-lexbraces b/changelog.d/issue-9098-lexbraces
new file mode 100644
index 0000000000..19bb0bbee3
--- /dev/null
+++ b/changelog.d/issue-9098-lexbraces
@@ -0,0 +1,18 @@
+synopsis: Add LexBraces lexer warning
+packages: Cabal-syntax
+issues: #8577
+
+description: {
+
+LexBraces warning is issued when brace delimiting syntax is used.
+This way, using `readFields'`, a low-lever consumer may decide
+whether braces were used.
+
+(Looking for a brace character in the input is imprecise, as braces can occur inside field content).
+
+This warning is not propagated to parser warnings,
+so e.g. readGenericPackageDescription doesn't warn about it.
+This is because all parser warnings prevent uploads to Hackage,
+and using braces (or not) is opinionated choice.
+
+}
-- 
GitLab