Syntax inconsistency lint: throw warning at both sites of inconsistency

src/GLua/AG/Token.ag

@@ -11,7 +11,6 @@ import GHC.Generics
 import GLua.Position
 }
 
-type TokenList = [Token]
 type MTokenList = [MToken]
 
 -- | Simple token types

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

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,19 +29,68 @@ 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
+
+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
+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
 
+-- | 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
@@ -73,7 +123,7 @@ endOfTrailingWhitespace (pos, []) = pos
 ----------------------------------------
 -- Attributes
 ----------------------------------------
-attr MTokenList MToken Token TokenList
+attr MTokenList MToken Token
  syn copy :: self
  inh config :: LintSettings
 
@@ -90,38 +140,34 @@ attr MTokenList MToken Token TokenList
 
  chn nextTokenPos :: LineColPos
 
-attr Token TokenList
- syn tokenWarnings use {++} {[]} :: {[Issue]}
-
 attr Token
- syn customWarnings use {++} {[]} :: {[FilePath -> LintMessage]} -- Warnings where the position is modified
+ inh mpos :: Region
 
 ---------------------------------------
 -- Semantics
 ---------------------------------------
 sem MTokenList
  | Cons
-
  | Nil
 
 
 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
 
- -- 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 (isInfixOf "\n " @space) (isInfixOf "\n\t" @space)
- loc.inconsistent = luaUsed @loc.whitespaceUsed && cUsed @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
@@ -130,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) || not @loc.inconsistent then id else
-  (:) $ mTokenWarning @loc.indentationRg InconsistentTabsSpaces
+ +warnings = if not (lint_whitespaceStyle @lhs.config) then id else
+ warnInconsistency @loc.combinedSyntaxUsed InconsistentTabsSpaces
 
  | DashComment
- lhs.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
- +tokenWarnings = if @loc.consistent then id else
- (:) $ SyntaxInconsistency "--" "//"
+ loc.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy
+
+ 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
- lhs.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy
- loc.consistent = (not . lint_syntaxInconsistencies $ @lhs.config) || (not . luaUsed $ @lhs.lineCommentSyntax)
- loc.lineCommentSyntax = SyntaxUsed False @loc.consistent
- +tokenWarnings = if @loc.consistent then id else
- (:) $ SyntaxInconsistency "//" "--"
+ loc.nextTokenPos = customAdvanceToken @lhs.nextTokenPos @loc.copy
+
+ 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 @loc.consistent False
- +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 False @loc.consistent
- +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 @loc.consistent False
  -- 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 character ' ' strings
- loc.strSyntax = SyntaxUsed False (@loc.consistent && not (isSingleChar @str))
  -- 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 @loc.consistent False
- +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 False @loc.consistent
- +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 @loc.consistent False
- +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 False @loc.consistent
- +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 @loc.consistent False
- +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 False @loc.consistent
- +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 @loc.consistent False
- +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 False @loc.consistent
- +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)

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