From 0bbb489b6c686e1a850b2bb0602a2a5873e88b15 Mon Sep 17 00:00:00 2001 From: Falco Peijnenburg Date: Fri, 29 Dec 2023 16:14:52 +0100 Subject: [PATCH 1/3] Remove TokenList --- src/GLua/AG/Token.ag | 1 - src/GLuaFixer/AG/ASTLint.ag | 2 +- src/GLuaFixer/AG/LexLint.ag | 7 ++----- 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/src/GLua/AG/Token.ag b/src/GLua/AG/Token.ag index fd473c4..3718034 100644 --- a/src/GLua/AG/Token.ag +++ b/src/GLua/AG/Token.ag @@ -11,7 +11,6 @@ import GHC.Generics import GLua.Position } -type TokenList = [Token] type MTokenList = [MToken] -- | Simple token types diff --git a/src/GLuaFixer/AG/ASTLint.ag b/src/GLuaFixer/AG/ASTLint.ag index 91ef15c..3fc6b18 100644 --- a/src/GLuaFixer/AG/ASTLint.ag +++ b/src/GLuaFixer/AG/ASTLint.ag @@ -149,7 +149,7 @@ attr AllStuff MToken MTokenList attr Block inh isRepeat :: Bool -- Scopes should not be popped and certain errors are not to be thrown when this is the body of a repeat -attr AllStuff MToken MTokenList Token TokenList +attr AllStuff MToken MTokenList Token syn warnings use {++} {[]} :: {[String -> LintMessage]} syn copy :: self syn identifier use {const} {unknownIdentifier} :: String -- identifier of the first token diff --git a/src/GLuaFixer/AG/LexLint.ag b/src/GLuaFixer/AG/LexLint.ag index 6783a5f..7c216bf 100644 --- a/src/GLuaFixer/AG/LexLint.ag +++ b/src/GLuaFixer/AG/LexLint.ag @@ -73,7 +73,7 @@ endOfTrailingWhitespace (pos, []) = pos ---------------------------------------- -- Attributes ---------------------------------------- -attr MTokenList MToken Token TokenList +attr MTokenList MToken Token syn copy :: self inh config :: LintSettings @@ -90,10 +90,8 @@ attr MTokenList MToken Token TokenList chn nextTokenPos :: LineColPos -attr Token TokenList - syn tokenWarnings use {++} {[]} :: {[Issue]} - attr Token + syn tokenWarnings use {++} {[]} :: {[Issue]} syn customWarnings use {++} {[]} :: {[FilePath -> LintMessage]} -- Warnings where the position is modified --------------------------------------- @@ -101,7 +99,6 @@ attr Token --------------------------------------- sem MTokenList | Cons - | Nil From 0fc7aa6f707f5907be81fda265fa0df586d2b69b Mon Sep 17 00:00:00 2001 From: Falco Peijnenburg Date: Fri, 29 Dec 2023 16:15:07 +0100 Subject: [PATCH 2/3] Store regions instead of bools in SyntaxUsed --- src/GLuaFixer/AG/LexLint.ag | 80 +++++++++++++++++++++++++------------ 1 file changed, 55 insertions(+), 25 deletions(-) diff --git a/src/GLuaFixer/AG/LexLint.ag b/src/GLuaFixer/AG/LexLint.ag index 7c216bf..5c91e24 100644 --- a/src/GLuaFixer/AG/LexLint.ag +++ b/src/GLuaFixer/AG/LexLint.ag @@ -13,6 +13,7 @@ module {GLuaFixer.AG.LexLint} imports { +import Control.Applicative ((<|>)) import Data.List import GLua.TokenTypes import GLua.AG.Token @@ -28,15 +29,41 @@ include "../../GLua/AG/Token.ag" ---------------------------------------- -- C-style / Lua-style syntax inconsistencies ---------------------------------------- --- For detecting the usage of Lua/C syntax inconsistently -data SyntaxUsed = SyntaxUsed { luaUsed :: Bool, cUsed :: Bool } deriving (Show) +-- For detecting the usage of Lua/C syntax inconsistently. 'Nothing' means no evidence of the style, +-- and 'Just Region' represents the last place where the style was found to be used. +data SyntaxUsed = SyntaxUsed + { lastLuaExample :: Maybe Region + , lastCExample :: Maybe Region + } + deriving (Show) instance Semigroup SyntaxUsed where - (SyntaxUsed l1 c1) <> (SyntaxUsed l2 c2) = SyntaxUsed (l1 || l2) (c1 || c2) + -- Later uses have preference over earlier uses + (SyntaxUsed l1 c1) <> (SyntaxUsed l2 c2) = SyntaxUsed (l2 <|> l1) (c2 <|> c1) -- Monoid instance instance Monoid SyntaxUsed where - mempty = SyntaxUsed False False + mempty = SyntaxUsed Nothing Nothing + +-- | Whether there is evidence of Lua style code +luaUsed :: SyntaxUsed -> Bool +luaUsed (SyntaxUsed (Just _) _) = True +luaUsed _ = False + +-- | Whether there is evidence of C style code +cUsed :: SyntaxUsed -> Bool +cUsed (SyntaxUsed _ (Just _)) = True +cUsed _ = False + +-- | Quick helper to turn a bool and region into a member for 'SyntaxUsed' +mkSyntax :: Bool -> Region -> Maybe Region +mkSyntax b region = if b then Just region else Nothing + +-- | Whether the syntax is consistent +consistent :: SyntaxUsed -> Bool +consistent syntaxUsed = case syntaxUsed of + SyntaxUsed (Just _) (Just _) -> False + _ -> True mTokenWarning :: Region -> Issue -> FilePath -> LintMessage mTokenWarning pos issue = LintMessage LintWarning pos issue @@ -93,6 +120,7 @@ attr MTokenList MToken Token attr Token syn tokenWarnings use {++} {[]} :: {[Issue]} syn customWarnings use {++} {[]} :: {[FilePath -> LintMessage]} -- Warnings where the position is modified + inh mpos :: Region --------------------------------------- -- Semantics @@ -104,7 +132,8 @@ sem MTokenList sem MToken | MToken - loc.mpos = Region @lhs.nextTokenPos (customAdvanceToken @lhs.nextTokenPos @mtok.copy) + loc.mpos = Region @lhs.nextTokenPos @mtok.nextTokenPos + mtok.mpos = @loc.mpos -- Note: the const is here to avoid a "defined but not used" warning in the generated hs -- file. loc.copy = MToken (const @loc.mpos @mpos) @mtok.copy @@ -117,8 +146,9 @@ sem Token loc.curTokenPos = @lhs.nextTokenPos loc.nextTokenPos = customAdvanceStr @loc.curTokenPos @space loc.indentation = if @loc.inconsistent then mempty else @loc.whitespaceUsed - loc.whitespaceUsed = @lhs.indentation <> SyntaxUsed (isInfixOf "\n " @space) (isInfixOf "\n\t" @space) - loc.inconsistent = luaUsed @loc.whitespaceUsed && cUsed @loc.whitespaceUsed + loc.whitespaceUsed = + @lhs.indentation <> SyntaxUsed (mkSyntax (isInfixOf "\n " @space) @loc.indentationRg) (mkSyntax (isInfixOf "\n\t" @space) @loc.indentationRg) + loc.inconsistent = consistent @loc.whitespaceUsed -- Start and end of trailing whitespace loc.whitespaceStart = locateTrailingWhitespace @loc.curTokenPos @space @@ -129,20 +159,20 @@ sem Token +customWarnings = if not (lint_trailingWhitespace @lhs.config) || (not (isInfixOf " \n" @space) && not (isInfixOf "\t\n" @space)) then id else (:) $ mTokenWarning (Region (fst @loc.whitespaceStart) @loc.whitespaceEnd) TrailingWhitespace - +customWarnings = if not (lint_whitespaceStyle @lhs.config) || not @loc.inconsistent then id else + +customWarnings = if not (lint_whitespaceStyle @lhs.config) || consistent @loc.whitespaceUsed then id else (:) $ mTokenWarning @loc.indentationRg InconsistentTabsSpaces | DashComment - lhs.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy + loc.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.lineCommentSyntax) - loc.lineCommentSyntax = SyntaxUsed @loc.consistent False -- When inconsistent, reset consistency check + loc.lineCommentSyntax = SyntaxUsed (Just @lhs.mpos) Nothing -- When inconsistent, reset consistency check +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "--" "//" | SlashComment - lhs.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy + loc.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.lineCommentSyntax) - loc.lineCommentSyntax = SyntaxUsed False @loc.consistent + loc.lineCommentSyntax = SyntaxUsed Nothing (Just @lhs.mpos) +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "//" "--" @@ -151,7 +181,7 @@ sem Token loc.str = showString "--[" . showString (replicate @depth '-') . showChar '[' . showString @comment . showChar ']' . showString (replicate @depth '-') . showChar ']' $ "" lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos @loc.str loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.multilineCommentSyntax) - loc.multilineCommentSyntax = SyntaxUsed @loc.consistent False + loc.multilineCommentSyntax = SyntaxUsed (Just @lhs.mpos) Nothing +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "--[[ ]]" "/* */" @@ -159,7 +189,7 @@ sem Token loc.str = showString "/*" . showString @comment . showString "*/" $ "" lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos @loc.str loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.multilineCommentSyntax) - loc.multilineCommentSyntax = SyntaxUsed False @loc.consistent + loc.multilineCommentSyntax = SyntaxUsed Nothing (Just @lhs.mpos) +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "/* */" "--[[ ]]" @@ -168,15 +198,15 @@ sem Token | DQString loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.strSyntax) - loc.strSyntax = SyntaxUsed @loc.consistent False + loc.strSyntax = SyntaxUsed (Just @lhs.mpos) Nothing -- Apply custom advancement of the string, but also have the advancement take the quotes into account lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos $ "\"" <> @str <> "\"" +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "double quoted strings" "single quoted strings" | SQString - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.strSyntax) || isSingleChar @str -- Allow single character ' ' strings - loc.strSyntax = SyntaxUsed False (@loc.consistent && not (isSingleChar @str)) + loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.strSyntax) || isSingleChar @str -- Allow single strings containing a single character + loc.strSyntax = SyntaxUsed Nothing (if isSingleChar @str then Nothing else Just @lhs.mpos) -- Apply custom advancement of the string, but also have the advancement take the quotes into account lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos $ "'" <> @str <> "'" +tokenWarnings = if @loc.consistent then id else @@ -187,49 +217,49 @@ sem Token | Not loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.notSyntax) - loc.notSyntax = SyntaxUsed @loc.consistent False + loc.notSyntax = SyntaxUsed (Just @lhs.mpos) Nothing +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "not" "!" | CNot loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.notSyntax) - loc.notSyntax = SyntaxUsed False @loc.consistent + loc.notSyntax = SyntaxUsed Nothing (Just @lhs.mpos) +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "!" "not" | And loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.andSyntax) - loc.andSyntax = SyntaxUsed @loc.consistent False + loc.andSyntax = SyntaxUsed (Just @lhs.mpos) Nothing +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "and" "&&" | CAnd loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.andSyntax) - loc.andSyntax = SyntaxUsed False @loc.consistent + loc.andSyntax = SyntaxUsed Nothing (Just @lhs.mpos) +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "&&" "and" | Or loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.orSyntax) - loc.orSyntax = SyntaxUsed @loc.consistent False + loc.orSyntax = SyntaxUsed (Just @lhs.mpos) Nothing +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "or" "||" | COr loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.orSyntax) - loc.orSyntax = SyntaxUsed False @loc.consistent + loc.orSyntax = SyntaxUsed Nothing (Just @lhs.mpos) +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "||" "or" | TNEq loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.neqSyntax) - loc.neqSyntax = SyntaxUsed @loc.consistent False + loc.neqSyntax = SyntaxUsed (Just @lhs.mpos) Nothing +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "~=" "!=" | TCNEq loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.neqSyntax) - loc.neqSyntax = SyntaxUsed False @loc.consistent + loc.neqSyntax = SyntaxUsed Nothing (Just @lhs.mpos) +tokenWarnings = if @loc.consistent then id else (:) $ SyntaxInconsistency "!=" "~=" From 147d78bd0c389dc9dbe33f2085aec608de86e69b Mon Sep 17 00:00:00 2001 From: Falco Peijnenburg Date: Fri, 29 Dec 2023 18:56:19 +0100 Subject: [PATCH 3/3] Throw warning at both places of inconsistency --- src/GLuaFixer/AG/LexLint.ag | 163 +++++++++++++++++++++--------------- tests/linttest/Spec.hs | 12 ++- 2 files changed, 103 insertions(+), 72 deletions(-) diff --git a/src/GLuaFixer/AG/LexLint.ag b/src/GLuaFixer/AG/LexLint.ag index 5c91e24..2f8d78e 100644 --- a/src/GLuaFixer/AG/LexLint.ag +++ b/src/GLuaFixer/AG/LexLint.ag @@ -45,6 +45,12 @@ instance Semigroup SyntaxUsed where instance Monoid SyntaxUsed where mempty = SyntaxUsed Nothing Nothing +previousSyntaxUsedRegion :: SyntaxUsed -> Maybe Region +previousSyntaxUsedRegion syntaxUsed = case syntaxUsed of + SyntaxUsed (Just l) (Just c) -> Just $ min l c + -- There is no previous region if there is no syntax inconsistency + SyntaxUsed {} -> Nothing + -- | Whether there is evidence of Lua style code luaUsed :: SyntaxUsed -> Bool luaUsed (SyntaxUsed (Just _) _) = True @@ -68,6 +74,23 @@ consistent syntaxUsed = case syntaxUsed of mTokenWarning :: Region -> Issue -> FilePath -> LintMessage mTokenWarning pos issue = LintMessage LintWarning pos issue +-- | Shorthand for throwing _two_ warnings when an inconsistency occurs: one at the original place +-- and one at the new place. +warnInconsistency :: SyntaxUsed -> Issue -> [FilePath -> LintMessage] -> [FilePath -> LintMessage] +warnInconsistency syntaxUsed issue messages = case syntaxUsed of + SyntaxUsed (Just luaRegion) (Just cRegion) -> + LintMessage LintWarning luaRegion issue : + LintMessage LintWarning cRegion issue : + messages + _ -> messages + +-- | Handy function to reset the built up knowledge of 'SyntaxUsed' when it is found to be +-- inconsistent. +resetIfInconsistent :: SyntaxUsed -> SyntaxUsed +resetIfInconsistent syntaxUsed = case syntaxUsed of + SyntaxUsed (Just {}) (Just {}) -> SyntaxUsed Nothing Nothing + _ -> syntaxUsed + isSingleChar :: String -> Bool isSingleChar [] = True isSingleChar ('\\' : xs) = length xs == 1 @@ -118,8 +141,6 @@ attr MTokenList MToken Token chn nextTokenPos :: LineColPos attr Token - syn tokenWarnings use {++} {[]} :: {[Issue]} - syn customWarnings use {++} {[]} :: {[FilePath -> LintMessage]} -- Warnings where the position is modified inh mpos :: Region --------------------------------------- @@ -138,17 +159,15 @@ sem MToken -- file. loc.copy = MToken (const @loc.mpos @mpos) @mtok.copy - -- Warnings from tokens - lhs.warnings = @mtok.customWarnings ++ map (mTokenWarning @loc.mpos) @mtok.tokenWarnings - sem Token | Whitespace loc.curTokenPos = @lhs.nextTokenPos loc.nextTokenPos = customAdvanceStr @loc.curTokenPos @space - loc.indentation = if @loc.inconsistent then mempty else @loc.whitespaceUsed - loc.whitespaceUsed = - @lhs.indentation <> SyntaxUsed (mkSyntax (isInfixOf "\n " @space) @loc.indentationRg) (mkSyntax (isInfixOf "\n\t" @space) @loc.indentationRg) - loc.inconsistent = consistent @loc.whitespaceUsed + + loc.usesSpaces = mkSyntax (isInfixOf "\n " @space) @loc.indentationRg + loc.usesTabs = mkSyntax (isInfixOf "\n\t" @space) @loc.indentationRg + loc.combinedSyntaxUsed = @lhs.indentation <> SyntaxUsed @loc.usesSpaces @loc.usesTabs + loc.indentation = resetIfInconsistent @loc.combinedSyntaxUsed -- Start and end of trailing whitespace loc.whitespaceStart = locateTrailingWhitespace @loc.curTokenPos @space @@ -157,111 +176,119 @@ sem Token -- Start and end of indentation at the start of a line loc.indentationRg = Region (indentationStart @loc.curTokenPos @space) @loc.nextTokenPos - +customWarnings = if not (lint_trailingWhitespace @lhs.config) || (not (isInfixOf " \n" @space) && not (isInfixOf "\t\n" @space)) then id else (:) $ mTokenWarning (Region (fst @loc.whitespaceStart) @loc.whitespaceEnd) TrailingWhitespace + +warnings = if not (lint_trailingWhitespace @lhs.config) || (not (isInfixOf " \n" @space) && not (isInfixOf "\t\n" @space)) then id else (:) $ mTokenWarning (Region (fst @loc.whitespaceStart) @loc.whitespaceEnd) TrailingWhitespace - +customWarnings = if not (lint_whitespaceStyle @lhs.config) || consistent @loc.whitespaceUsed then id else - (:) $ mTokenWarning @loc.indentationRg InconsistentTabsSpaces + +warnings = if not (lint_whitespaceStyle @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed InconsistentTabsSpaces | DashComment loc.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.lineCommentSyntax) - loc.lineCommentSyntax = SyntaxUsed (Just @lhs.mpos) Nothing -- When inconsistent, reset consistency check - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "--" "//" + + loc.combinedSyntaxUsed = @lhs.lineCommentSyntax <> SyntaxUsed (Just @lhs.mpos) Nothing + loc.lineCommentSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "--" "//" | SlashComment loc.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.lineCommentSyntax) - loc.lineCommentSyntax = SyntaxUsed Nothing (Just @lhs.mpos) - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "//" "--" + + loc.combinedSyntaxUsed = @lhs.lineCommentSyntax <> SyntaxUsed Nothing (Just @lhs.mpos) + loc.lineCommentSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "//" "--" | DashBlockComment loc.str = showString "--[" . showString (replicate @depth '-') . showChar '[' . showString @comment . showChar ']' . showString (replicate @depth '-') . showChar ']' $ "" lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos @loc.str - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.multilineCommentSyntax) - loc.multilineCommentSyntax = SyntaxUsed (Just @lhs.mpos) Nothing - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "--[[ ]]" "/* */" + + loc.combinedSyntaxUsed = @lhs.multilineCommentSyntax <> SyntaxUsed (Just @lhs.mpos) Nothing + loc.multilineCommentSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "--[[ ]]" "/* */" | SlashBlockComment loc.str = showString "/*" . showString @comment . showString "*/" $ "" lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos @loc.str - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.multilineCommentSyntax) - loc.multilineCommentSyntax = SyntaxUsed Nothing (Just @lhs.mpos) - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "/* */" "--[[ ]]" + + loc.combinedSyntaxUsed = @lhs.multilineCommentSyntax <> SyntaxUsed Nothing (Just @lhs.mpos) + loc.multilineCommentSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "/* */" "--[[ ]]" | Semicolon TNumber TTrue TFalse Nil VarArg Plus Minus Multiply Divide Modulus Power TEq TNEq TCNEq TLEQ TGEQ TLT TGT Equals Concatenate Colon Dot Comma Hash Not CNot And CAnd Or COr Function Local If Then Elseif Else For In Do While Until Repeat Continue Break Return End LRound RRound LCurly RCurly LSquare RSquare Identifier lhs.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy | DQString - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.strSyntax) - loc.strSyntax = SyntaxUsed (Just @lhs.mpos) Nothing -- Apply custom advancement of the string, but also have the advancement take the quotes into account lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos $ "\"" <> @str <> "\"" - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "double quoted strings" "single quoted strings" + + loc.combinedSyntaxUsed = @lhs.strSyntax <> SyntaxUsed (Just @lhs.mpos) Nothing + loc.strSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "double quoted strings" "single quoted strings" | SQString - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.strSyntax) || isSingleChar @str -- Allow single strings containing a single character - loc.strSyntax = SyntaxUsed Nothing (if isSingleChar @str then Nothing else Just @lhs.mpos) -- Apply custom advancement of the string, but also have the advancement take the quotes into account lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos $ "'" <> @str <> "'" - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "single quoted strings" "double quoted strings" + + -- Allow single strings containing a single character + loc.usesSingleQuotedSyntax = if isSingleChar @str then Nothing else Just @lhs.mpos + loc.combinedSyntaxUsed = @lhs.strSyntax <> SyntaxUsed Nothing @loc.usesSingleQuotedSyntax + loc.strSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "single quoted strings" "double quoted strings" | MLString lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos @str | Not - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.notSyntax) - loc.notSyntax = SyntaxUsed (Just @lhs.mpos) Nothing - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "not" "!" + loc.combinedSyntaxUsed = @lhs.notSyntax <> SyntaxUsed (Just @lhs.mpos) Nothing + loc.notSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "not" "!" | CNot - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.notSyntax) - loc.notSyntax = SyntaxUsed Nothing (Just @lhs.mpos) - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "!" "not" + loc.combinedSyntaxUsed = @lhs.notSyntax <> SyntaxUsed Nothing (Just @lhs.mpos) + loc.notSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "!" "not" | And - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.andSyntax) - loc.andSyntax = SyntaxUsed (Just @lhs.mpos) Nothing - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "and" "&&" + loc.combinedSyntaxUsed = @lhs.andSyntax <> SyntaxUsed (Just @lhs.mpos) Nothing + loc.andSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "and" "&&" | CAnd - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.andSyntax) - loc.andSyntax = SyntaxUsed Nothing (Just @lhs.mpos) - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "&&" "and" + loc.combinedSyntaxUsed = @lhs.andSyntax <> SyntaxUsed Nothing (Just @lhs.mpos) + loc.andSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "&&" "and" | Or - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.orSyntax) - loc.orSyntax = SyntaxUsed (Just @lhs.mpos) Nothing - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "or" "||" + loc.combinedSyntaxUsed = @lhs.orSyntax <> SyntaxUsed (Just @lhs.mpos) Nothing + loc.orSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "or" "||" | COr - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.orSyntax) - loc.orSyntax = SyntaxUsed Nothing (Just @lhs.mpos) - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "||" "or" + loc.combinedSyntaxUsed = @lhs.orSyntax <> SyntaxUsed Nothing (Just @lhs.mpos) + loc.orSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "||" "or" | TNEq - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . cUsed $ @lhs.neqSyntax) - loc.neqSyntax = SyntaxUsed (Just @lhs.mpos) Nothing - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "~=" "!=" + loc.combinedSyntaxUsed = @lhs.neqSyntax <> SyntaxUsed (Just @lhs.mpos) Nothing + loc.neqSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "~=" "!=" | TCNEq - loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.neqSyntax) - loc.neqSyntax = SyntaxUsed Nothing (Just @lhs.mpos) - +tokenWarnings = if @loc.consistent then id else - (:) $ SyntaxInconsistency "!=" "~=" + loc.combinedSyntaxUsed = @lhs.neqSyntax <> SyntaxUsed Nothing (Just @lhs.mpos) + loc.neqSyntax = resetIfInconsistent @loc.combinedSyntaxUsed + +warnings = if not (lint_syntaxInconsistencies @lhs.config) then id else + warnInconsistency @loc.combinedSyntaxUsed $ SyntaxInconsistency "!=" "~=" | Label lhs.nextTokenPos = customAdvanceStr @lhs.nextTokenPos (show @loc.copy) diff --git a/tests/linttest/Spec.hs b/tests/linttest/Spec.hs index cfd91de..b8adeef 100644 --- a/tests/linttest/Spec.hs +++ b/tests/linttest/Spec.hs @@ -28,11 +28,15 @@ testQuotedStringWarningPosition = testCase "The syntax inconsistency warning is thrown and in the right region" $ let input = "bar = a or b\nfoo = \"\" and \"\" and \"dddd\" || \"[]\"" - expectedRegion = Region (LineColPos 1 27 40) (LineColPos 1 29 42) - warning = SyntaxInconsistency "||" "or" - msg = LintMessage LintWarning expectedRegion warning testFilePath + expectedRegion1 = Region (LineColPos 0 8 8) (LineColPos 0 10 10) + warning1 = SyntaxInconsistency "||" "or" + msg1 = LintMessage LintWarning expectedRegion1 warning1 testFilePath + + expectedRegion2 = Region (LineColPos 1 27 40) (LineColPos 1 29 42) + warning2 = SyntaxInconsistency "||" "or" + msg2 = LintMessage LintWarning expectedRegion2 warning2 testFilePath in - lintString input @=? [msg] + [msg1, msg2] @=? lintString input -- | Regression test for https://github.com/FPtje/GLuaFixer/issues/170 testEmptyIfWarningPosition :: TestTree