{-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# LANGUAGE CPP #-} -- UUAGC 0.9.53.1 (src/GLuaFixer/AG/LexLint.ag) module GLuaFixer.AG.LexLint( lintWarnings, fixedLexPositions ) where {-# LINE 9 "src/GLuaFixer/AG/../../GLua/AG/Token.ag" #-} import Text.ParserCombinators.UU.BasicInstances hiding (pos) import GHC.Generics {-# LINE 19 "src/GLuaFixer/AG/LexLint.hs" #-} {-# LINE 15 "src/GLuaFixer/AG/LexLint.ag" #-} import Data.List import GLua.TokenTypes import GLua.AG.Token import GLuaFixer.LintMessage import GLuaFixer.LintSettings {-# LINE 28 "src/GLuaFixer/AG/LexLint.hs" #-} {-# LINE 25 "src/GLuaFixer/AG/LexLint.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) instance Semigroup SyntaxUsed where (SyntaxUsed l1 c1) <> (SyntaxUsed l2 c2) = SyntaxUsed (l1 || l2) (c1 || c2) -- Monoid instance instance Monoid SyntaxUsed where mempty = SyntaxUsed False False mTokenWarning :: Region -> Issue -> FilePath -> LintMessage mTokenWarning pos issue = LintMessage LintWarning pos issue isSingleChar :: String -> Bool isSingleChar [] = True isSingleChar ('\\' : xs) = length xs == 1 isSingleChar (_ : []) = True isSingleChar _ = False -- Locate the exact position of trailing whitespace locateTrailingWhitespace :: LineColPos -> String -> (LineColPos, String) locateTrailingWhitespace pos (' ' : xs) = (pos, xs) locateTrailingWhitespace pos ('\t' : xs) = (pos, xs) locateTrailingWhitespace pos (x : xs) = locateTrailingWhitespace (customAdvanceChr pos x) xs locateTrailingWhitespace pos [] = (pos, "") -- Locate the start of a line's indentation in a string of whitespace indentationStart :: LineColPos -> String -> LineColPos indentationStart pos = go pos pos where go :: LineColPos -> LineColPos -> String -> LineColPos go _ cur ('\n' : xs) = let next = customAdvanceChr cur '\n' in go next next xs go found cur (x : xs) = go found (customAdvanceChr cur x) xs go found _ [] = found endOfTrailingWhitespace :: (LineColPos, String) -> LineColPos endOfTrailingWhitespace (pos, ('\n' : _)) = pos endOfTrailingWhitespace (pos, (x : xs)) = endOfTrailingWhitespace (customAdvanceChr pos x, xs) endOfTrailingWhitespace (pos, []) = pos {-# LINE 76 "src/GLuaFixer/AG/LexLint.hs" #-} {-# LINE 235 "src/GLuaFixer/AG/LexLint.ag" #-} inh_MTokenList :: LintSettings -> Inh_MTokenList inh_MTokenList conf = Inh_MTokenList { config_Inh_MTokenList = conf, andSyntax_Inh_MTokenList = mempty, indentation_Inh_MTokenList = mempty, lineCommentSyntax_Inh_MTokenList = mempty, multilineCommentSyntax_Inh_MTokenList = mempty, neqSyntax_Inh_MTokenList = mempty, notSyntax_Inh_MTokenList = mempty, orSyntax_Inh_MTokenList = mempty, strSyntax_Inh_MTokenList = mempty, nextTokenPos_Inh_MTokenList = LineColPos 0 0 0 } lintWarnings :: LintSettings -> [MToken] -> [String -> LintMessage] lintWarnings conf p = warnings_Syn_MTokenList (wrap_MTokenList (sem_MTokenList p) (inh_MTokenList conf)) -- Necessary because uu-parsinglib's LineColPos walks over tabs as though they are 8 spaces. Note -- that this also applies when the code is lexed by the Parsec lexer. fixedLexPositions :: [MToken] -> [MToken] fixedLexPositions p = copy_Syn_MTokenList (wrap_MTokenList (sem_MTokenList p) (inh_MTokenList defaultLintSettings)) {-# LINE 104 "src/GLuaFixer/AG/LexLint.hs" #-} -- MToken ------------------------------------------------------ -- cata sem_MToken :: MToken -> T_MToken sem_MToken (MToken _mpos _mtok) = (sem_MToken_MToken (sem_Region _mpos) (sem_Token _mtok)) -- semantic domain type T_MToken = SyntaxUsed -> LintSettings -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> LineColPos -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> ( SyntaxUsed,MToken,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,LineColPos,SyntaxUsed,SyntaxUsed,SyntaxUsed,([FilePath -> LintMessage])) data Inh_MToken = Inh_MToken {andSyntax_Inh_MToken :: SyntaxUsed,config_Inh_MToken :: LintSettings,indentation_Inh_MToken :: SyntaxUsed,lineCommentSyntax_Inh_MToken :: SyntaxUsed,multilineCommentSyntax_Inh_MToken :: SyntaxUsed,neqSyntax_Inh_MToken :: SyntaxUsed,nextTokenPos_Inh_MToken :: LineColPos,notSyntax_Inh_MToken :: SyntaxUsed,orSyntax_Inh_MToken :: SyntaxUsed,strSyntax_Inh_MToken :: SyntaxUsed} data Syn_MToken = Syn_MToken {andSyntax_Syn_MToken :: SyntaxUsed,copy_Syn_MToken :: MToken,indentation_Syn_MToken :: SyntaxUsed,lineCommentSyntax_Syn_MToken :: SyntaxUsed,multilineCommentSyntax_Syn_MToken :: SyntaxUsed,neqSyntax_Syn_MToken :: SyntaxUsed,nextTokenPos_Syn_MToken :: LineColPos,notSyntax_Syn_MToken :: SyntaxUsed,orSyntax_Syn_MToken :: SyntaxUsed,strSyntax_Syn_MToken :: SyntaxUsed,warnings_Syn_MToken :: ([FilePath -> LintMessage])} wrap_MToken :: T_MToken -> Inh_MToken -> Syn_MToken wrap_MToken sem (Inh_MToken _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax) = (let ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) = sem _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax in (Syn_MToken _lhsOandSyntax _lhsOcopy _lhsOindentation _lhsOlineCommentSyntax _lhsOmultilineCommentSyntax _lhsOneqSyntax _lhsOnextTokenPos _lhsOnotSyntax _lhsOorSyntax _lhsOstrSyntax _lhsOwarnings)) sem_MToken_MToken :: T_Region -> T_Token -> T_MToken sem_MToken_MToken mpos_ mtok_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 77 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 147 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOconfig -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 152 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOandSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 157 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOstrSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 162 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOorSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 167 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOnotSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 172 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOnextTokenPos -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 177 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOneqSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 182 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOmultilineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 187 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOlineCommentSyntax -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 192 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOindentation -> (case (({-# LINE 77 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 197 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mposOconfig -> (case (mpos_ _mposOandSyntax _mposOconfig _mposOindentation _mposOlineCommentSyntax _mposOmultilineCommentSyntax _mposOneqSyntax _mposOnextTokenPos _mposOnotSyntax _mposOorSyntax _mposOstrSyntax) of { ( _mposIandSyntax,_mposIcopy,_mposIindentation,_mposIlineCommentSyntax,_mposImultilineCommentSyntax,_mposIneqSyntax,_mposInextTokenPos,_mposInotSyntax,_mposIorSyntax,_mposIstrSyntax,_mposIwarnings) -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _mposIandSyntax {-# LINE 204 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOandSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _mposIstrSyntax {-# LINE 209 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOstrSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _mposIorSyntax {-# LINE 214 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOorSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _mposInotSyntax {-# LINE 219 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOnotSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _mposInextTokenPos {-# LINE 224 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOnextTokenPos -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _mposIneqSyntax {-# LINE 229 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOneqSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _mposImultilineCommentSyntax {-# LINE 234 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOmultilineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _mposIlineCommentSyntax {-# LINE 239 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOlineCommentSyntax -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _mposIindentation {-# LINE 244 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOindentation -> (case (mtok_ _mtokOandSyntax _mtokOconfig _mtokOindentation _mtokOlineCommentSyntax _mtokOmultilineCommentSyntax _mtokOneqSyntax _mtokOnextTokenPos _mtokOnotSyntax _mtokOorSyntax _mtokOstrSyntax) of { ( _mtokIandSyntax,_mtokIcopy,_mtokIcustomWarnings,_mtokIindentation,_mtokIlineCommentSyntax,_mtokImultilineCommentSyntax,_mtokIneqSyntax,_mtokInextTokenPos,_mtokInotSyntax,_mtokIorSyntax,_mtokIstrSyntax,_mtokItokenWarnings,_mtokIwarnings) -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIandSyntax {-# LINE 251 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 109 "src/GLuaFixer/AG/LexLint.ag" #-} Region _lhsInextTokenPos (customAdvanceToken _lhsInextTokenPos _mtokIcopy) {-# LINE 256 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mpos -> (case (({-# LINE 110 "src/GLuaFixer/AG/LexLint.ag" #-} MToken _mpos _mtokIcopy {-# LINE 261 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 266 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIindentation {-# LINE 271 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIlineCommentSyntax {-# LINE 276 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokImultilineCommentSyntax {-# LINE 281 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIneqSyntax {-# LINE 286 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokInextTokenPos {-# LINE 291 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokInotSyntax {-# LINE 296 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIorSyntax {-# LINE 301 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIstrSyntax {-# LINE 306 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 113 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIcustomWarnings ++ map (mTokenWarning _mpos ) _mtokItokenWarnings {-# LINE 311 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) -- MTokenList -------------------------------------------------- -- cata sem_MTokenList :: MTokenList -> T_MTokenList sem_MTokenList list = (Prelude.foldr sem_MTokenList_Cons sem_MTokenList_Nil (Prelude.map sem_MToken list)) -- semantic domain type T_MTokenList = SyntaxUsed -> LintSettings -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> LineColPos -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> ( SyntaxUsed,MTokenList,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,LineColPos,SyntaxUsed,SyntaxUsed,SyntaxUsed,([FilePath -> LintMessage])) data Inh_MTokenList = Inh_MTokenList {andSyntax_Inh_MTokenList :: SyntaxUsed,config_Inh_MTokenList :: LintSettings,indentation_Inh_MTokenList :: SyntaxUsed,lineCommentSyntax_Inh_MTokenList :: SyntaxUsed,multilineCommentSyntax_Inh_MTokenList :: SyntaxUsed,neqSyntax_Inh_MTokenList :: SyntaxUsed,nextTokenPos_Inh_MTokenList :: LineColPos,notSyntax_Inh_MTokenList :: SyntaxUsed,orSyntax_Inh_MTokenList :: SyntaxUsed,strSyntax_Inh_MTokenList :: SyntaxUsed} data Syn_MTokenList = Syn_MTokenList {andSyntax_Syn_MTokenList :: SyntaxUsed,copy_Syn_MTokenList :: MTokenList,indentation_Syn_MTokenList :: SyntaxUsed,lineCommentSyntax_Syn_MTokenList :: SyntaxUsed,multilineCommentSyntax_Syn_MTokenList :: SyntaxUsed,neqSyntax_Syn_MTokenList :: SyntaxUsed,nextTokenPos_Syn_MTokenList :: LineColPos,notSyntax_Syn_MTokenList :: SyntaxUsed,orSyntax_Syn_MTokenList :: SyntaxUsed,strSyntax_Syn_MTokenList :: SyntaxUsed,warnings_Syn_MTokenList :: ([FilePath -> LintMessage])} wrap_MTokenList :: T_MTokenList -> Inh_MTokenList -> Syn_MTokenList wrap_MTokenList sem (Inh_MTokenList _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax) = (let ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) = sem _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax in (Syn_MTokenList _lhsOandSyntax _lhsOcopy _lhsOindentation _lhsOlineCommentSyntax _lhsOmultilineCommentSyntax _lhsOneqSyntax _lhsOnextTokenPos _lhsOnotSyntax _lhsOorSyntax _lhsOstrSyntax _lhsOwarnings)) sem_MTokenList_Cons :: T_MToken -> T_MTokenList -> T_MTokenList sem_MTokenList_Cons hd_ tl_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 77 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 357 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOconfig -> (case (({-# LINE 77 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 362 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 367 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOandSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 372 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOstrSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 377 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOorSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 382 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOnotSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 387 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOnextTokenPos -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 392 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOneqSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 397 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOmultilineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 402 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOlineCommentSyntax -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 407 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOindentation -> (case (hd_ _hdOandSyntax _hdOconfig _hdOindentation _hdOlineCommentSyntax _hdOmultilineCommentSyntax _hdOneqSyntax _hdOnextTokenPos _hdOnotSyntax _hdOorSyntax _hdOstrSyntax) of { ( _hdIandSyntax,_hdIcopy,_hdIindentation,_hdIlineCommentSyntax,_hdImultilineCommentSyntax,_hdIneqSyntax,_hdInextTokenPos,_hdInotSyntax,_hdIorSyntax,_hdIstrSyntax,_hdIwarnings) -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIandSyntax {-# LINE 414 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOandSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIstrSyntax {-# LINE 419 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOstrSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIorSyntax {-# LINE 424 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOorSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _hdInotSyntax {-# LINE 429 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOnotSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _hdInextTokenPos {-# LINE 434 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOnextTokenPos -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIneqSyntax {-# LINE 439 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOneqSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _hdImultilineCommentSyntax {-# LINE 444 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOmultilineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIlineCommentSyntax {-# LINE 449 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOlineCommentSyntax -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIindentation {-# LINE 454 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOindentation -> (case (tl_ _tlOandSyntax _tlOconfig _tlOindentation _tlOlineCommentSyntax _tlOmultilineCommentSyntax _tlOneqSyntax _tlOnextTokenPos _tlOnotSyntax _tlOorSyntax _tlOstrSyntax) of { ( _tlIandSyntax,_tlIcopy,_tlIindentation,_tlIlineCommentSyntax,_tlImultilineCommentSyntax,_tlIneqSyntax,_tlInextTokenPos,_tlInotSyntax,_tlIorSyntax,_tlIstrSyntax,_tlIwarnings) -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIandSyntax {-# LINE 461 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 466 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 471 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIindentation {-# LINE 476 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIlineCommentSyntax {-# LINE 481 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _tlImultilineCommentSyntax {-# LINE 486 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIneqSyntax {-# LINE 491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _tlInextTokenPos {-# LINE 496 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _tlInotSyntax {-# LINE 501 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIorSyntax {-# LINE 506 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIstrSyntax {-# LINE 511 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 516 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_MTokenList_Nil :: T_MTokenList sem_MTokenList_Nil = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 534 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 539 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 544 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 549 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 554 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 559 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 564 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 569 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 574 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 579 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 584 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 589 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) })) -- Region ------------------------------------------------------ -- cata sem_Region :: Region -> T_Region sem_Region (Region _start _end) = (sem_Region_Region _start _end) -- semantic domain type T_Region = SyntaxUsed -> LintSettings -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> LineColPos -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> ( SyntaxUsed,Region,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,LineColPos,SyntaxUsed,SyntaxUsed,SyntaxUsed,([FilePath -> LintMessage])) data Inh_Region = Inh_Region {andSyntax_Inh_Region :: SyntaxUsed,config_Inh_Region :: LintSettings,indentation_Inh_Region :: SyntaxUsed,lineCommentSyntax_Inh_Region :: SyntaxUsed,multilineCommentSyntax_Inh_Region :: SyntaxUsed,neqSyntax_Inh_Region :: SyntaxUsed,nextTokenPos_Inh_Region :: LineColPos,notSyntax_Inh_Region :: SyntaxUsed,orSyntax_Inh_Region :: SyntaxUsed,strSyntax_Inh_Region :: SyntaxUsed} data Syn_Region = Syn_Region {andSyntax_Syn_Region :: SyntaxUsed,copy_Syn_Region :: Region,indentation_Syn_Region :: SyntaxUsed,lineCommentSyntax_Syn_Region :: SyntaxUsed,multilineCommentSyntax_Syn_Region :: SyntaxUsed,neqSyntax_Syn_Region :: SyntaxUsed,nextTokenPos_Syn_Region :: LineColPos,notSyntax_Syn_Region :: SyntaxUsed,orSyntax_Syn_Region :: SyntaxUsed,strSyntax_Syn_Region :: SyntaxUsed,warnings_Syn_Region :: ([FilePath -> LintMessage])} wrap_Region :: T_Region -> Inh_Region -> Syn_Region wrap_Region sem (Inh_Region _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax) = (let ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) = sem _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax in (Syn_Region _lhsOandSyntax _lhsOcopy _lhsOindentation _lhsOlineCommentSyntax _lhsOmultilineCommentSyntax _lhsOneqSyntax _lhsOnextTokenPos _lhsOnotSyntax _lhsOorSyntax _lhsOstrSyntax _lhsOwarnings)) sem_Region_Region :: LineColPos -> LineColPos -> T_Region sem_Region_Region start_ end_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 635 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Region start_ end_ {-# LINE 640 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 645 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 650 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 655 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 660 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 665 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 670 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 675 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 680 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 685 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 690 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) })) -- Token ------------------------------------------------------- -- cata sem_Token :: Token -> T_Token sem_Token (Whitespace _space) = (sem_Token_Whitespace _space) sem_Token (DashComment _comment) = (sem_Token_DashComment _comment) sem_Token (DashBlockComment _depth _comment) = (sem_Token_DashBlockComment _depth _comment) sem_Token (SlashComment _comment) = (sem_Token_SlashComment _comment) sem_Token (SlashBlockComment _comment) = (sem_Token_SlashBlockComment _comment) sem_Token (Semicolon) = (sem_Token_Semicolon) sem_Token (TNumber _num) = (sem_Token_TNumber _num) sem_Token (DQString _str) = (sem_Token_DQString _str) sem_Token (SQString _str) = (sem_Token_SQString _str) sem_Token (MLString _str) = (sem_Token_MLString _str) sem_Token (TTrue) = (sem_Token_TTrue) sem_Token (TFalse) = (sem_Token_TFalse) sem_Token (Nil) = (sem_Token_Nil) sem_Token (VarArg) = (sem_Token_VarArg) sem_Token (Plus) = (sem_Token_Plus) sem_Token (Minus) = (sem_Token_Minus) sem_Token (Multiply) = (sem_Token_Multiply) sem_Token (Divide) = (sem_Token_Divide) sem_Token (Modulus) = (sem_Token_Modulus) sem_Token (Power) = (sem_Token_Power) sem_Token (TEq) = (sem_Token_TEq) sem_Token (TNEq) = (sem_Token_TNEq) sem_Token (TCNEq) = (sem_Token_TCNEq) sem_Token (TLEQ) = (sem_Token_TLEQ) sem_Token (TGEQ) = (sem_Token_TGEQ) sem_Token (TLT) = (sem_Token_TLT) sem_Token (TGT) = (sem_Token_TGT) sem_Token (Equals) = (sem_Token_Equals) sem_Token (Concatenate) = (sem_Token_Concatenate) sem_Token (Colon) = (sem_Token_Colon) sem_Token (Dot) = (sem_Token_Dot) sem_Token (Comma) = (sem_Token_Comma) sem_Token (Hash) = (sem_Token_Hash) sem_Token (Not) = (sem_Token_Not) sem_Token (CNot) = (sem_Token_CNot) sem_Token (And) = (sem_Token_And) sem_Token (CAnd) = (sem_Token_CAnd) sem_Token (Or) = (sem_Token_Or) sem_Token (COr) = (sem_Token_COr) sem_Token (Function) = (sem_Token_Function) sem_Token (Local) = (sem_Token_Local) sem_Token (If) = (sem_Token_If) sem_Token (Then) = (sem_Token_Then) sem_Token (Elseif) = (sem_Token_Elseif) sem_Token (Else) = (sem_Token_Else) sem_Token (For) = (sem_Token_For) sem_Token (In) = (sem_Token_In) sem_Token (Do) = (sem_Token_Do) sem_Token (While) = (sem_Token_While) sem_Token (Until) = (sem_Token_Until) sem_Token (Repeat) = (sem_Token_Repeat) sem_Token (Continue) = (sem_Token_Continue) sem_Token (Break) = (sem_Token_Break) sem_Token (Return) = (sem_Token_Return) sem_Token (End) = (sem_Token_End) sem_Token (LRound) = (sem_Token_LRound) sem_Token (RRound) = (sem_Token_RRound) sem_Token (LCurly) = (sem_Token_LCurly) sem_Token (RCurly) = (sem_Token_RCurly) sem_Token (LSquare) = (sem_Token_LSquare) sem_Token (RSquare) = (sem_Token_RSquare) sem_Token (Label _lbl) = (sem_Token_Label _lbl) sem_Token (Identifier _ident) = (sem_Token_Identifier _ident) -- semantic domain type T_Token = SyntaxUsed -> LintSettings -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> LineColPos -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> ( SyntaxUsed,Token,([FilePath -> LintMessage]),SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,LineColPos,SyntaxUsed,SyntaxUsed,SyntaxUsed,([Issue]),([FilePath -> LintMessage])) data Inh_Token = Inh_Token {andSyntax_Inh_Token :: SyntaxUsed,config_Inh_Token :: LintSettings,indentation_Inh_Token :: SyntaxUsed,lineCommentSyntax_Inh_Token :: SyntaxUsed,multilineCommentSyntax_Inh_Token :: SyntaxUsed,neqSyntax_Inh_Token :: SyntaxUsed,nextTokenPos_Inh_Token :: LineColPos,notSyntax_Inh_Token :: SyntaxUsed,orSyntax_Inh_Token :: SyntaxUsed,strSyntax_Inh_Token :: SyntaxUsed} data Syn_Token = Syn_Token {andSyntax_Syn_Token :: SyntaxUsed,copy_Syn_Token :: Token,customWarnings_Syn_Token :: ([FilePath -> LintMessage]),indentation_Syn_Token :: SyntaxUsed,lineCommentSyntax_Syn_Token :: SyntaxUsed,multilineCommentSyntax_Syn_Token :: SyntaxUsed,neqSyntax_Syn_Token :: SyntaxUsed,nextTokenPos_Syn_Token :: LineColPos,notSyntax_Syn_Token :: SyntaxUsed,orSyntax_Syn_Token :: SyntaxUsed,strSyntax_Syn_Token :: SyntaxUsed,tokenWarnings_Syn_Token :: ([Issue]),warnings_Syn_Token :: ([FilePath -> LintMessage])} wrap_Token :: T_Token -> Inh_Token -> Syn_Token wrap_Token sem (Inh_Token _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax) = (let ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) = sem _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax in (Syn_Token _lhsOandSyntax _lhsOcopy _lhsOcustomWarnings _lhsOindentation _lhsOlineCommentSyntax _lhsOmultilineCommentSyntax _lhsOneqSyntax _lhsOnextTokenPos _lhsOnotSyntax _lhsOorSyntax _lhsOstrSyntax _lhsOtokenWarnings _lhsOwarnings)) sem_Token_Whitespace :: String -> T_Token sem_Token_Whitespace space_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 859 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Whitespace space_ {-# LINE 864 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 869 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 874 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _customWarnings_augmented_syn -> (case (({-# LINE 117 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 879 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _curTokenPos -> (case (({-# LINE 118 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _curTokenPos space_ {-# LINE 884 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _nextTokenPos -> (case (({-# LINE 128 "src/GLuaFixer/AG/LexLint.ag" #-} Region (indentationStart _curTokenPos space_) _nextTokenPos {-# LINE 889 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _indentationRg -> (case (({-# LINE 124 "src/GLuaFixer/AG/LexLint.ag" #-} locateTrailingWhitespace _curTokenPos space_ {-# LINE 894 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _whitespaceStart -> (case (({-# LINE 125 "src/GLuaFixer/AG/LexLint.ag" #-} endOfTrailingWhitespace _whitespaceStart {-# LINE 899 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _whitespaceEnd -> (case (({-# LINE 120 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation <> SyntaxUsed (isInfixOf "\n " space_) (isInfixOf "\n\t" space_) {-# LINE 904 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _whitespaceUsed -> (case (({-# LINE 121 "src/GLuaFixer/AG/LexLint.ag" #-} luaUsed _whitespaceUsed && cUsed _whitespaceUsed {-# LINE 909 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _inconsistent -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_trailingWhitespace _lhsIconfig) || (not (isInfixOf " \n" space_) && not (isInfixOf "\t\n" space_)) then id else (:) $ mTokenWarning (Region (fst _whitespaceStart ) _whitespaceEnd ) TrailingWhitespace {-# LINE 914 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _customWarnings_augmented_f2 -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_whitespaceStyle _lhsIconfig) || not _inconsistent then id else (:) $ mTokenWarning _indentationRg InconsistentTabsSpaces {-# LINE 920 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _customWarnings_augmented_f1 -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _customWarnings_augmented_syn [_customWarnings_augmented_f1, _customWarnings_augmented_f2] {-# LINE 925 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 119 "src/GLuaFixer/AG/LexLint.ag" #-} if _inconsistent then mempty else _whitespaceUsed {-# LINE 930 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _indentation -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _indentation {-# LINE 935 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 940 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 945 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 950 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _nextTokenPos {-# LINE 955 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 960 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 965 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 970 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 975 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 980 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_DashComment :: String -> T_Token sem_Token_DashComment comment_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 999 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} DashComment comment_ {-# LINE 1004 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1009 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1014 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1019 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . cUsed $ _lhsIlineCommentSyntax) {-# LINE 1024 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed _consistent False {-# LINE 1029 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lineCommentSyntax {-# LINE 1034 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1039 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1044 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1049 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1054 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1059 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1064 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1069 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "--" "//" {-# LINE 1075 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 1080 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1085 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_DashBlockComment :: Int -> String -> T_Token sem_Token_DashBlockComment depth_ comment_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1105 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} DashBlockComment depth_ comment_ {-# LINE 1110 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1115 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1120 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1125 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1130 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 153 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . cUsed $ _lhsImultilineCommentSyntax) {-# LINE 1135 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 154 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed _consistent False {-# LINE 1140 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _multilineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _multilineCommentSyntax {-# LINE 1145 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1150 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 151 "src/GLuaFixer/AG/LexLint.ag" #-} showString "--[" . showString (replicate depth_ '-') . showChar '[' . showString comment_ . showChar ']' . showString (replicate depth_ '-') . showChar ']' $ "" {-# LINE 1155 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _str -> (case (({-# LINE 152 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos _str {-# LINE 1160 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1165 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1170 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1175 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 155 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1180 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 155 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "--[[ ]]" "/* */" {-# LINE 1186 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 155 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 1191 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1196 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_SlashComment :: String -> T_Token sem_Token_SlashComment comment_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1215 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} SlashComment comment_ {-# LINE 1220 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1225 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1230 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1235 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 144 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . luaUsed $ _lhsIlineCommentSyntax) {-# LINE 1240 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 145 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed False _consistent {-# LINE 1245 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lineCommentSyntax {-# LINE 1250 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1255 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1260 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 143 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1265 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1270 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1275 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1280 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 146 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1285 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 146 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "//" "--" {-# LINE 1291 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 146 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 1296 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1301 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_SlashBlockComment :: String -> T_Token sem_Token_SlashBlockComment comment_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1320 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} SlashBlockComment comment_ {-# LINE 1325 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1330 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1335 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1340 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1345 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 161 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . luaUsed $ _lhsImultilineCommentSyntax) {-# LINE 1350 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 162 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed False _consistent {-# LINE 1355 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _multilineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _multilineCommentSyntax {-# LINE 1360 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1365 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 159 "src/GLuaFixer/AG/LexLint.ag" #-} showString "/*" . showString comment_ . showString "*/" $ "" {-# LINE 1370 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _str -> (case (({-# LINE 160 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos _str {-# LINE 1375 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1380 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1385 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1390 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 163 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1395 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 163 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "/* */" "--[[ ]]" {-# LINE 1401 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 163 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 1406 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1411 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Semicolon :: T_Token sem_Token_Semicolon = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1429 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Semicolon {-# LINE 1434 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1439 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1444 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1449 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1454 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1459 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1464 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1469 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1474 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1479 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1484 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1489 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1494 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TNumber :: String -> T_Token sem_Token_TNumber num_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1513 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TNumber num_ {-# LINE 1518 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1523 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1528 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1533 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1538 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1543 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1548 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1553 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1558 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1563 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1568 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1573 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1578 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_DQString :: String -> T_Token sem_Token_DQString str_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1597 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} DQString str_ {-# LINE 1602 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1607 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1612 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1617 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1622 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1627 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1632 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1637 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1642 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1647 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 170 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . cUsed $ _lhsIstrSyntax) {-# LINE 1652 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 171 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed _consistent False {-# LINE 1657 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _strSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _strSyntax {-# LINE 1662 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 172 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1667 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 172 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "double quoted strings" "single quoted strings" {-# LINE 1673 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 172 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 1678 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1683 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_SQString :: String -> T_Token sem_Token_SQString str_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1702 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} SQString str_ {-# LINE 1707 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1712 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1717 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1722 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1727 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1732 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1737 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1742 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1747 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1752 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 176 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . luaUsed $ _lhsIstrSyntax) || isSingleChar str_ {-# LINE 1757 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 177 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed False (_consistent && not (isSingleChar str_)) {-# LINE 1762 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _strSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _strSyntax {-# LINE 1767 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 178 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1772 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 178 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "single quoted strings" "double quoted strings" {-# LINE 1778 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 178 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 1783 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1788 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_MLString :: String -> T_Token sem_Token_MLString str_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1807 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} MLString str_ {-# LINE 1812 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1817 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1822 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1827 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1832 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1837 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1842 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 182 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos str_ {-# LINE 1847 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1852 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1857 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1862 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1867 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1872 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TTrue :: T_Token sem_Token_TTrue = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1890 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TTrue {-# LINE 1895 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1900 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1905 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1910 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1915 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1920 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1925 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1930 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1935 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1940 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1945 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1950 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1955 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TFalse :: T_Token sem_Token_TFalse = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1973 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TFalse {-# LINE 1978 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1983 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1988 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1993 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1998 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2003 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2008 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2013 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2018 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2023 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2028 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2033 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2038 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Nil :: T_Token sem_Token_Nil = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2056 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Nil {-# LINE 2061 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2066 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2071 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2076 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2081 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2086 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2091 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2096 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2101 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2106 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2111 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2116 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2121 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_VarArg :: T_Token sem_Token_VarArg = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2139 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} VarArg {-# LINE 2144 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2149 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2154 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2159 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2164 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2169 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2174 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2179 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2184 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2189 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2194 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2199 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2204 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Plus :: T_Token sem_Token_Plus = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2222 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Plus {-# LINE 2227 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2232 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2237 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2242 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2247 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2252 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2257 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2262 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2267 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2272 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2277 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2282 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2287 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Minus :: T_Token sem_Token_Minus = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2305 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Minus {-# LINE 2310 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2315 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2320 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2325 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2330 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2335 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2340 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2345 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2350 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2355 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2360 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2365 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2370 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Multiply :: T_Token sem_Token_Multiply = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2388 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Multiply {-# LINE 2393 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2398 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2403 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2408 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2413 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2418 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2423 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2428 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2433 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2438 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2443 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2448 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2453 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Divide :: T_Token sem_Token_Divide = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2471 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Divide {-# LINE 2476 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2481 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2486 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2496 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2501 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2506 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2511 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2516 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2521 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2526 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2531 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2536 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Modulus :: T_Token sem_Token_Modulus = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2554 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Modulus {-# LINE 2559 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2564 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2569 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2574 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2579 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2584 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2589 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2594 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2599 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2604 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2609 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2614 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2619 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Power :: T_Token sem_Token_Power = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2637 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Power {-# LINE 2642 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2647 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2652 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2657 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2662 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2667 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2672 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2677 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2682 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2687 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2692 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2697 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2702 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TEq :: T_Token sem_Token_TEq = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2720 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TEq {-# LINE 2725 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2730 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2735 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2740 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2745 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2750 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2755 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2760 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2765 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2770 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2775 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2780 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2785 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TNEq :: T_Token sem_Token_TNEq = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2803 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TNEq {-# LINE 2808 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2813 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2818 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2823 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2828 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2833 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 221 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . cUsed $ _lhsIneqSyntax) {-# LINE 2838 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 222 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed _consistent False {-# LINE 2843 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _neqSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _neqSyntax {-# LINE 2848 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2853 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2858 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2863 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2868 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 223 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2873 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 223 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "~=" "!=" {-# LINE 2879 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 223 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 2884 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2889 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TCNEq :: T_Token sem_Token_TCNEq = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2907 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TCNEq {-# LINE 2912 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2917 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2922 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2927 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2932 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2937 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 227 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . luaUsed $ _lhsIneqSyntax) {-# LINE 2942 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 228 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed False _consistent {-# LINE 2947 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _neqSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _neqSyntax {-# LINE 2952 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2957 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2962 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2967 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2972 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 229 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2977 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 229 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "!=" "~=" {-# LINE 2983 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 229 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 2988 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2993 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TLEQ :: T_Token sem_Token_TLEQ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3011 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TLEQ {-# LINE 3016 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3021 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3026 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3031 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3036 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3041 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3046 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3051 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3056 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3061 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3066 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3071 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3076 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TGEQ :: T_Token sem_Token_TGEQ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3094 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TGEQ {-# LINE 3099 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3104 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3109 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3114 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3119 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3124 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3129 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3134 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3139 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3144 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3149 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3154 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3159 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TLT :: T_Token sem_Token_TLT = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3177 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TLT {-# LINE 3182 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3187 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3192 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3197 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3202 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3207 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3212 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3217 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3222 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3227 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3232 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3237 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3242 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_TGT :: T_Token sem_Token_TGT = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3260 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} TGT {-# LINE 3265 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3270 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3275 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3280 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3285 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3290 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3295 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3300 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3305 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3310 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3315 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3320 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3325 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Equals :: T_Token sem_Token_Equals = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3343 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Equals {-# LINE 3348 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3353 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3358 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3363 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3368 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3373 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3378 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3383 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3388 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3393 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3398 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3403 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3408 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Concatenate :: T_Token sem_Token_Concatenate = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3426 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Concatenate {-# LINE 3431 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3436 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3441 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3446 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3451 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3456 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3461 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3466 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3471 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3476 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3481 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3486 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Colon :: T_Token sem_Token_Colon = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3509 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Colon {-# LINE 3514 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3519 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3524 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3529 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3534 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3539 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3544 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3549 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3554 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3559 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3564 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3569 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3574 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Dot :: T_Token sem_Token_Dot = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3592 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Dot {-# LINE 3597 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3602 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3607 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3612 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3617 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3622 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3627 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3632 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3637 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3642 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3647 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3652 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3657 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Comma :: T_Token sem_Token_Comma = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3675 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Comma {-# LINE 3680 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3685 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3690 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3695 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3700 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3705 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3710 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3715 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3720 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3725 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3730 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3735 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3740 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Hash :: T_Token sem_Token_Hash = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3758 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Hash {-# LINE 3763 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3768 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3773 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3778 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3783 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3788 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3793 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3798 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3803 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3808 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3813 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3818 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3823 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Not :: T_Token sem_Token_Not = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3841 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Not {-# LINE 3846 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3851 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3856 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3861 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3866 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3871 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3876 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3881 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 185 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . cUsed $ _lhsInotSyntax) {-# LINE 3886 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 186 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed _consistent False {-# LINE 3891 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _notSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _notSyntax {-# LINE 3896 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3901 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3906 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 187 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3911 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 187 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "not" "!" {-# LINE 3917 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 187 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 3922 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3927 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_CNot :: T_Token sem_Token_CNot = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3945 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} CNot {-# LINE 3950 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3955 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3960 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3965 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3970 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3975 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3980 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3985 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 191 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . luaUsed $ _lhsInotSyntax) {-# LINE 3990 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 192 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed False _consistent {-# LINE 3995 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _notSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _notSyntax {-# LINE 4000 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4005 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4010 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 193 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4015 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 193 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "!" "not" {-# LINE 4021 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 193 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 4026 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4031 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_And :: T_Token sem_Token_And = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 197 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . cUsed $ _lhsIandSyntax) {-# LINE 4049 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 198 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed _consistent False {-# LINE 4054 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _andSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _andSyntax {-# LINE 4059 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} And {-# LINE 4064 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4069 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4074 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4079 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4084 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4089 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4094 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4099 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4104 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4109 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4114 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 199 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4119 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 199 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "and" "&&" {-# LINE 4125 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 199 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 4130 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4135 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_CAnd :: T_Token sem_Token_CAnd = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 203 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . luaUsed $ _lhsIandSyntax) {-# LINE 4153 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 204 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed False _consistent {-# LINE 4158 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _andSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _andSyntax {-# LINE 4163 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} CAnd {-# LINE 4168 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4173 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4178 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4183 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4188 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4193 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4198 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4203 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4208 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4213 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4218 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 205 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4223 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 205 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "&&" "and" {-# LINE 4229 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 205 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 4234 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4239 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Or :: T_Token sem_Token_Or = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4257 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Or {-# LINE 4262 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4267 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4272 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4277 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4282 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4287 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4292 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4297 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4302 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 209 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . cUsed $ _lhsIorSyntax) {-# LINE 4307 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 210 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed _consistent False {-# LINE 4312 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _orSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _orSyntax {-# LINE 4317 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4322 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 211 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4327 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 211 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "or" "||" {-# LINE 4333 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 211 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 4338 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4343 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_COr :: T_Token sem_Token_COr = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4361 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} COr {-# LINE 4366 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4371 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4376 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4381 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4386 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4391 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4396 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4401 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4406 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 215 "src/GLuaFixer/AG/LexLint.ag" #-} (not . lint_syntaxInconsistencies $ _lhsIconfig) || (not . luaUsed $ _lhsIorSyntax) {-# LINE 4411 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _consistent -> (case (({-# LINE 216 "src/GLuaFixer/AG/LexLint.ag" #-} SyntaxUsed False _consistent {-# LINE 4416 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _orSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _orSyntax {-# LINE 4421 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4426 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 217 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4431 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_syn -> (case (({-# LINE 217 "src/GLuaFixer/AG/LexLint.ag" #-} if _consistent then id else (:) $ SyntaxInconsistency "||" "or" {-# LINE 4437 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tokenWarnings_augmented_f1 -> (case (({-# LINE 217 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _tokenWarnings_augmented_syn [_tokenWarnings_augmented_f1] {-# LINE 4442 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4447 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Function :: T_Token sem_Token_Function = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4465 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Function {-# LINE 4470 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4475 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4480 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4485 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4490 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4495 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4500 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4505 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4510 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4515 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4520 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4525 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4530 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Local :: T_Token sem_Token_Local = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4548 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Local {-# LINE 4553 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4558 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4563 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4568 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4573 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4578 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4583 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4588 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4593 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4598 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4603 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4608 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4613 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_If :: T_Token sem_Token_If = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4631 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} If {-# LINE 4636 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4641 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4646 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4651 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4656 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4661 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4666 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4671 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4676 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4681 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4686 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4691 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4696 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Then :: T_Token sem_Token_Then = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4714 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Then {-# LINE 4719 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4724 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4729 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4734 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4739 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4744 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4749 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4754 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4759 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4764 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4769 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4774 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4779 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Elseif :: T_Token sem_Token_Elseif = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4797 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Elseif {-# LINE 4802 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4807 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4812 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4817 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4822 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4827 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4832 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4837 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4842 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4847 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4852 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4857 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4862 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Else :: T_Token sem_Token_Else = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4880 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Else {-# LINE 4885 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4890 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4895 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4900 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4905 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4910 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4915 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4920 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4925 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4930 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4935 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4940 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4945 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_For :: T_Token sem_Token_For = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4963 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} For {-# LINE 4968 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4973 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4978 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4983 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4988 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4993 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4998 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5003 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5008 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5013 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5018 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5023 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5028 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_In :: T_Token sem_Token_In = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5046 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} In {-# LINE 5051 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5056 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5061 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5066 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5071 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5076 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5081 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5086 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5091 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5096 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5101 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5106 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5111 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Do :: T_Token sem_Token_Do = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5129 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Do {-# LINE 5134 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5139 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5144 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5149 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5154 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5159 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5164 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5169 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5174 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5179 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5184 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5189 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5194 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_While :: T_Token sem_Token_While = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5212 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} While {-# LINE 5217 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5222 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5227 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5232 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5237 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5242 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5247 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5252 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5257 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5262 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5267 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5272 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5277 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Until :: T_Token sem_Token_Until = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5295 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Until {-# LINE 5300 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5305 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5310 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5315 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5320 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5325 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5330 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5335 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5340 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5345 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5350 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5355 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5360 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Repeat :: T_Token sem_Token_Repeat = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5378 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Repeat {-# LINE 5383 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5388 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5393 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5398 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5403 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5408 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5413 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5418 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5423 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5428 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5433 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5438 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5443 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Continue :: T_Token sem_Token_Continue = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5461 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Continue {-# LINE 5466 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5471 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5476 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5481 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5486 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5496 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5501 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5506 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5511 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5516 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5521 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5526 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Break :: T_Token sem_Token_Break = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5544 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Break {-# LINE 5549 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5554 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5559 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5564 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5569 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5574 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5579 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5584 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5589 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5594 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5599 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5604 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5609 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Return :: T_Token sem_Token_Return = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5627 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Return {-# LINE 5632 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5637 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5642 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5647 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5652 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5657 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5662 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5667 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5672 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5677 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5682 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5687 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5692 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_End :: T_Token sem_Token_End = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5710 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} End {-# LINE 5715 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5720 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5725 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5730 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5735 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5740 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5745 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5750 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5755 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5760 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5765 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5770 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5775 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_LRound :: T_Token sem_Token_LRound = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5793 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} LRound {-# LINE 5798 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5803 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5808 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5813 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5818 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5823 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5828 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5833 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5838 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5843 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5848 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5853 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5858 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_RRound :: T_Token sem_Token_RRound = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5876 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} RRound {-# LINE 5881 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5886 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5891 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5896 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5901 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5906 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5911 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5916 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5921 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5926 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5931 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5936 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5941 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_LCurly :: T_Token sem_Token_LCurly = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5959 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} LCurly {-# LINE 5964 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5969 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5974 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5979 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5984 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5989 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5994 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5999 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6004 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6009 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6014 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6019 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6024 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_RCurly :: T_Token sem_Token_RCurly = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6042 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} RCurly {-# LINE 6047 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6052 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6057 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6062 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6067 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6072 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6077 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 6082 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6087 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6092 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6097 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6102 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6107 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_LSquare :: T_Token sem_Token_LSquare = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6125 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} LSquare {-# LINE 6130 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6135 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6140 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6145 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6150 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6155 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6160 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 6165 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6170 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6175 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6180 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6185 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6190 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_RSquare :: T_Token sem_Token_RSquare = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6208 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} RSquare {-# LINE 6213 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6218 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6223 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6228 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6233 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6238 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6243 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 6248 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6253 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6258 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6263 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6268 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6273 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Label :: String -> T_Token sem_Token_Label lbl_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6292 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Label lbl_ {-# LINE 6297 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6302 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6307 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6312 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6317 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6322 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6327 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 233 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos (showString "::" . showString lbl_ . showString "::" $ "") {-# LINE 6332 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6337 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6342 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6347 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6352 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6357 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_Token_Identifier :: String -> T_Token sem_Token_Identifier ident_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6376 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} Identifier ident_ {-# LINE 6381 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6386 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 96 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6391 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcustomWarnings -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6396 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6401 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6406 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6411 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 6416 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6421 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6426 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6431 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6436 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6441 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOcustomWarnings,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) -- TokenList --------------------------------------------------- -- cata sem_TokenList :: TokenList -> T_TokenList sem_TokenList list = (Prelude.foldr sem_TokenList_Cons sem_TokenList_Nil (Prelude.map sem_Token list)) -- semantic domain type T_TokenList = SyntaxUsed -> LintSettings -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> LineColPos -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> ( SyntaxUsed,TokenList,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,LineColPos,SyntaxUsed,SyntaxUsed,SyntaxUsed,([Issue]),([FilePath -> LintMessage])) data Inh_TokenList = Inh_TokenList {andSyntax_Inh_TokenList :: SyntaxUsed,config_Inh_TokenList :: LintSettings,indentation_Inh_TokenList :: SyntaxUsed,lineCommentSyntax_Inh_TokenList :: SyntaxUsed,multilineCommentSyntax_Inh_TokenList :: SyntaxUsed,neqSyntax_Inh_TokenList :: SyntaxUsed,nextTokenPos_Inh_TokenList :: LineColPos,notSyntax_Inh_TokenList :: SyntaxUsed,orSyntax_Inh_TokenList :: SyntaxUsed,strSyntax_Inh_TokenList :: SyntaxUsed} data Syn_TokenList = Syn_TokenList {andSyntax_Syn_TokenList :: SyntaxUsed,copy_Syn_TokenList :: TokenList,indentation_Syn_TokenList :: SyntaxUsed,lineCommentSyntax_Syn_TokenList :: SyntaxUsed,multilineCommentSyntax_Syn_TokenList :: SyntaxUsed,neqSyntax_Syn_TokenList :: SyntaxUsed,nextTokenPos_Syn_TokenList :: LineColPos,notSyntax_Syn_TokenList :: SyntaxUsed,orSyntax_Syn_TokenList :: SyntaxUsed,strSyntax_Syn_TokenList :: SyntaxUsed,tokenWarnings_Syn_TokenList :: ([Issue]),warnings_Syn_TokenList :: ([FilePath -> LintMessage])} wrap_TokenList :: T_TokenList -> Inh_TokenList -> Syn_TokenList wrap_TokenList sem (Inh_TokenList _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax) = (let ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) = sem _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax in (Syn_TokenList _lhsOandSyntax _lhsOcopy _lhsOindentation _lhsOlineCommentSyntax _lhsOmultilineCommentSyntax _lhsOneqSyntax _lhsOnextTokenPos _lhsOnotSyntax _lhsOorSyntax _lhsOstrSyntax _lhsOtokenWarnings _lhsOwarnings)) sem_TokenList_Cons :: T_Token -> T_TokenList -> T_TokenList sem_TokenList_Cons hd_ tl_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 77 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 6487 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOconfig -> (case (({-# LINE 77 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 6492 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6497 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOandSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6502 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOstrSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6507 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOorSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6512 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOnotSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 6517 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOnextTokenPos -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6522 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOneqSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6527 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOmultilineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6532 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOlineCommentSyntax -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6537 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOindentation -> (case (hd_ _hdOandSyntax _hdOconfig _hdOindentation _hdOlineCommentSyntax _hdOmultilineCommentSyntax _hdOneqSyntax _hdOnextTokenPos _hdOnotSyntax _hdOorSyntax _hdOstrSyntax) of { ( _hdIandSyntax,_hdIcopy,_hdIcustomWarnings,_hdIindentation,_hdIlineCommentSyntax,_hdImultilineCommentSyntax,_hdIneqSyntax,_hdInextTokenPos,_hdInotSyntax,_hdIorSyntax,_hdIstrSyntax,_hdItokenWarnings,_hdIwarnings) -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIandSyntax {-# LINE 6544 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOandSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIstrSyntax {-# LINE 6549 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOstrSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIorSyntax {-# LINE 6554 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOorSyntax -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _hdInotSyntax {-# LINE 6559 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOnotSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _hdInextTokenPos {-# LINE 6564 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOnextTokenPos -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIneqSyntax {-# LINE 6569 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOneqSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _hdImultilineCommentSyntax {-# LINE 6574 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOmultilineCommentSyntax -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIlineCommentSyntax {-# LINE 6579 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOlineCommentSyntax -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIindentation {-# LINE 6584 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOindentation -> (case (tl_ _tlOandSyntax _tlOconfig _tlOindentation _tlOlineCommentSyntax _tlOmultilineCommentSyntax _tlOneqSyntax _tlOnextTokenPos _tlOnotSyntax _tlOorSyntax _tlOstrSyntax) of { ( _tlIandSyntax,_tlIcopy,_tlIindentation,_tlIlineCommentSyntax,_tlImultilineCommentSyntax,_tlIneqSyntax,_tlInextTokenPos,_tlInotSyntax,_tlIorSyntax,_tlIstrSyntax,_tlItokenWarnings,_tlIwarnings) -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIandSyntax {-# LINE 6591 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 6596 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6601 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIindentation {-# LINE 6606 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIlineCommentSyntax {-# LINE 6611 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _tlImultilineCommentSyntax {-# LINE 6616 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIneqSyntax {-# LINE 6621 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _tlInextTokenPos {-# LINE 6626 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _tlInotSyntax {-# LINE 6631 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIorSyntax {-# LINE 6636 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIstrSyntax {-# LINE 6641 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} _hdItokenWarnings ++ _tlItokenWarnings {-# LINE 6646 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 6651 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_TokenList_Nil :: T_TokenList sem_TokenList_Nil = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 84 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6669 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6674 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 76 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6679 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 88 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6684 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 81 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6689 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 82 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6694 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 86 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6699 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 90 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 6704 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 83 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6709 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 85 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6714 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 87 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6719 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 93 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6724 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOtokenWarnings -> (case (({-# LINE 79 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6729 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnextTokenPos,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOtokenWarnings,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }))