From bbbca4f3402f3446e39ebd71b7b757399984e41f Mon Sep 17 00:00:00 2001 From: Oleg Grenrus 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 782b8a2406f..601a1d579f6 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 bbbfeff1693..91c11ff1a63 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 00000000000..19bb0bbee35 --- /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. + +}