{-# 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 GHC.Generics import GLua.Position {-# LINE 19 "src/GLuaFixer/AG/LexLint.hs" #-} {-# LINE 15 "src/GLuaFixer/AG/LexLint.ag" #-} import Control.Applicative ((<|>)) import Data.List import GLua.TokenTypes import GLua.AG.Token import GLua.Position import GLuaFixer.LintMessage import GLuaFixer.LintSettings {-# LINE 30 "src/GLuaFixer/AG/LexLint.hs" #-} {-# LINE 27 "src/GLuaFixer/AG/LexLint.ag" #-} ---------------------------------------- -- C-style / Lua-style syntax inconsistencies ---------------------------------------- -- For detecting the usage of Lua/C syntax inconsistently. 'Nothing' means no evidence of the style, -- and 'Just Region' represents the last place where the style was found to be used. data SyntaxUsed = SyntaxUsed { lastLuaExample :: Maybe Region , lastCExample :: Maybe Region } deriving (Show) instance Semigroup SyntaxUsed where -- Later uses have preference over earlier uses (SyntaxUsed l1 c1) <> (SyntaxUsed l2 c2) = SyntaxUsed (l2 <|> l1) (c2 <|> c1) -- Monoid instance instance Monoid SyntaxUsed where mempty = SyntaxUsed Nothing Nothing previousSyntaxUsedRegion :: SyntaxUsed -> Maybe Region previousSyntaxUsedRegion syntaxUsed = case syntaxUsed of SyntaxUsed (Just l) (Just c) -> Just $ min l c -- There is no previous region if there is no syntax inconsistency SyntaxUsed {} -> Nothing -- | Whether there is evidence of Lua style code luaUsed :: SyntaxUsed -> Bool luaUsed (SyntaxUsed (Just _) _) = True luaUsed _ = False -- | Whether there is evidence of C style code cUsed :: SyntaxUsed -> Bool cUsed (SyntaxUsed _ (Just _)) = True cUsed _ = False -- | Quick helper to turn a bool and region into a member for 'SyntaxUsed' mkSyntax :: Bool -> Region -> Maybe Region mkSyntax b region = if b then Just region else Nothing -- | Whether the syntax is consistent consistent :: SyntaxUsed -> Bool consistent syntaxUsed = case syntaxUsed of SyntaxUsed (Just _) (Just _) -> False _ -> True mTokenWarning :: Region -> Issue -> FilePath -> LintMessage mTokenWarning pos issue = LintMessage LintWarning pos issue -- | Shorthand for throwing _two_ warnings when an inconsistency occurs: one at the original place -- and one at the new place. warnInconsistency :: SyntaxUsed -> Issue -> [FilePath -> LintMessage] -> [FilePath -> LintMessage] warnInconsistency syntaxUsed issue messages = case syntaxUsed of SyntaxUsed (Just luaRegion) (Just cRegion) -> LintMessage LintWarning luaRegion issue : LintMessage LintWarning cRegion issue : messages _ -> messages -- | Handy function to reset the built up knowledge of 'SyntaxUsed' when it is found to be -- inconsistent. resetIfInconsistent :: SyntaxUsed -> SyntaxUsed resetIfInconsistent syntaxUsed = case syntaxUsed of SyntaxUsed (Just {}) (Just {}) -> SyntaxUsed Nothing Nothing _ -> syntaxUsed isSingleChar :: String -> Bool isSingleChar [] = True isSingleChar ('\\' : xs) = length xs == 1 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 127 "src/GLuaFixer/AG/LexLint.hs" #-} {-# LINE 296 "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 the parser walks over tabs as though they are 8 spaces. fixedLexPositions :: [MToken] -> [MToken] fixedLexPositions p = copy_Syn_MTokenList (wrap_MTokenList (sem_MTokenList p) (inh_MTokenList defaultLintSettings)) {-# LINE 154 "src/GLuaFixer/AG/LexLint.hs" #-} -- MToken ------------------------------------------------------ -- cata sem_MToken :: MToken -> T_MToken sem_MToken (MToken _mpos _mtok) = (sem_MToken_MToken _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 :: Region -> T_Token -> T_MToken sem_MToken_MToken mpos_ mtok_ = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 197 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOnextTokenPos -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 202 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOandSyntax -> (case (mtok_ _mtokOnextTokenPos) of { ( _mtokInextTokenPos,mtok_1) -> (case (({-# LINE 156 "src/GLuaFixer/AG/LexLint.ag" #-} Region _lhsInextTokenPos _mtokInextTokenPos {-# LINE 209 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mpos -> (case (({-# LINE 157 "src/GLuaFixer/AG/LexLint.ag" #-} _mpos {-# LINE 214 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOmpos -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 219 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOstrSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 224 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOorSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 229 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOnotSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 234 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOneqSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 239 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOmultilineCommentSyntax -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 244 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOlineCommentSyntax -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 249 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOindentation -> (case (({-# LINE 128 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 254 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _mtokOconfig -> (case (mtok_1 _mtokOandSyntax _mtokOconfig _mtokOindentation _mtokOlineCommentSyntax _mtokOmpos _mtokOmultilineCommentSyntax _mtokOneqSyntax _mtokOnotSyntax _mtokOorSyntax _mtokOstrSyntax) of { ( _mtokIandSyntax,_mtokIcopy,_mtokIindentation,_mtokIlineCommentSyntax,_mtokImultilineCommentSyntax,_mtokIneqSyntax,_mtokInotSyntax,_mtokIorSyntax,_mtokIstrSyntax,_mtokIwarnings) -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIandSyntax {-# LINE 261 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 160 "src/GLuaFixer/AG/LexLint.ag" #-} MToken (const _mpos mpos_) _mtokIcopy {-# LINE 266 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 271 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIindentation {-# LINE 276 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIlineCommentSyntax {-# LINE 281 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokImultilineCommentSyntax {-# LINE 286 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIneqSyntax {-# LINE 291 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokInextTokenPos {-# LINE 296 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokInotSyntax {-# LINE 301 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIorSyntax {-# LINE 306 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIstrSyntax {-# LINE 311 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} _mtokIwarnings {-# LINE 316 "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 141 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 362 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOnextTokenPos -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 367 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOstrSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 372 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOorSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 377 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOnotSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 382 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOneqSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 387 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOmultilineCommentSyntax -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 392 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOlineCommentSyntax -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 397 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOindentation -> (case (({-# LINE 128 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 402 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOconfig -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 407 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _hdOandSyntax -> (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 141 "src/GLuaFixer/AG/LexLint.ag" #-} _hdInextTokenPos {-# LINE 414 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOnextTokenPos -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIandSyntax {-# LINE 419 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOandSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIstrSyntax {-# LINE 424 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOstrSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIorSyntax {-# LINE 429 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOorSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _hdInotSyntax {-# LINE 434 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOnotSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIneqSyntax {-# LINE 439 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOneqSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _hdImultilineCommentSyntax {-# LINE 444 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOmultilineCommentSyntax -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIlineCommentSyntax {-# LINE 449 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOlineCommentSyntax -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIindentation {-# LINE 454 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOindentation -> (case (({-# LINE 128 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIconfig {-# LINE 459 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _tlOconfig -> (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 135 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIandSyntax {-# LINE 466 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} (:) _hdIcopy _tlIcopy {-# LINE 471 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 476 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIindentation {-# LINE 481 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIlineCommentSyntax {-# LINE 486 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _tlImultilineCommentSyntax {-# LINE 491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIneqSyntax {-# LINE 496 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-} _tlInextTokenPos {-# LINE 501 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _tlInotSyntax {-# LINE 506 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIorSyntax {-# LINE 511 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _tlIstrSyntax {-# LINE 516 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} _hdIwarnings ++ _tlIwarnings {-# LINE 521 "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 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 539 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 544 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 549 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 554 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 559 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 564 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 569 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 574 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 579 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 584 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 589 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 594 "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 _whitespaceBefore _lbl _whitespaceAfter) = (sem_Token_Label _whitespaceBefore _lbl _whitespaceAfter) sem_Token (Identifier _ident) = (sem_Token_Identifier _ident) -- semantic domain type T_Token = LineColPos -> ( LineColPos,T_Token_1) type T_Token_1 = SyntaxUsed -> LintSettings -> SyntaxUsed -> SyntaxUsed -> Region -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> SyntaxUsed -> ( SyntaxUsed,Token,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,SyntaxUsed,([FilePath -> LintMessage])) data Inh_Token = Inh_Token {andSyntax_Inh_Token :: SyntaxUsed,config_Inh_Token :: LintSettings,indentation_Inh_Token :: SyntaxUsed,lineCommentSyntax_Inh_Token :: SyntaxUsed,mpos_Inh_Token :: Region,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,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,warnings_Syn_Token :: ([FilePath -> LintMessage])} wrap_Token :: T_Token -> Inh_Token -> Syn_Token wrap_Token sem (Inh_Token _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInextTokenPos _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax) = (let ( _lhsOnextTokenPos,sem_1) = sem _lhsInextTokenPos ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) = sem_1 _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax in (Syn_Token _lhsOandSyntax _lhsOcopy _lhsOindentation _lhsOlineCommentSyntax _lhsOmultilineCommentSyntax _lhsOneqSyntax _lhsOnextTokenPos _lhsOnotSyntax _lhsOorSyntax _lhsOstrSyntax _lhsOwarnings)) sem_Token_Whitespace :: String -> T_Token sem_Token_Whitespace space_ = (\ _lhsInextTokenPos -> (case (({-# LINE 164 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInextTokenPos {-# LINE 757 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _curTokenPos -> (case (({-# LINE 165 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _curTokenPos space_ {-# LINE 762 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _nextTokenPos -> (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-} _nextTokenPos {-# LINE 767 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Whitespace_1 :: T_Token_1 sem_Token_Whitespace_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 784 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Whitespace space_ {-# LINE 789 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 794 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 177 "src/GLuaFixer/AG/LexLint.ag" #-} Region (indentationStart _curTokenPos space_) _nextTokenPos {-# LINE 799 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _indentationRg -> (case (({-# LINE 168 "src/GLuaFixer/AG/LexLint.ag" #-} mkSyntax (isInfixOf "\n\t" space_) _indentationRg {-# LINE 804 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _usesTabs -> (case (({-# LINE 167 "src/GLuaFixer/AG/LexLint.ag" #-} mkSyntax (isInfixOf "\n " space_) _indentationRg {-# LINE 809 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _usesSpaces -> (case (({-# LINE 169 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation <> SyntaxUsed _usesSpaces _usesTabs {-# LINE 814 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 170 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 819 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _indentation -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _indentation {-# LINE 824 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 829 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 834 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 839 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 844 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 849 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 854 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 181 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 859 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 173 "src/GLuaFixer/AG/LexLint.ag" #-} locateTrailingWhitespace _curTokenPos space_ {-# LINE 864 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _whitespaceStart -> (case (({-# LINE 174 "src/GLuaFixer/AG/LexLint.ag" #-} endOfTrailingWhitespace _whitespaceStart {-# LINE 869 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _whitespaceEnd -> (case (({-# LINE 181 "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 874 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f2 -> (case (({-# LINE 181 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_whitespaceStyle _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed InconsistentTabsSpaces {-# LINE 880 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 181 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1, _warnings_augmented_f2] {-# LINE 885 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_Whitespace_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) }) })) sem_Token_DashComment :: String -> T_Token sem_Token_DashComment comment_ = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} DashComment comment_ {-# LINE 898 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 185 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 903 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _nextTokenPos -> (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-} _nextTokenPos {-# LINE 908 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_DashComment_1 :: T_Token_1 sem_Token_DashComment_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 925 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 930 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 935 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 187 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax <> SyntaxUsed (Just _lhsImpos) Nothing {-# LINE 940 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 188 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 945 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lineCommentSyntax -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lineCommentSyntax {-# LINE 950 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 955 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 960 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 965 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 970 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 975 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 189 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 980 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 189 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "--" "//" {-# LINE 986 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 189 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 991 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_DashComment_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) }) })) sem_Token_DashBlockComment :: Int -> String -> T_Token sem_Token_DashBlockComment depth_ comment_ = (\ _lhsInextTokenPos -> (case (({-# LINE 202 "src/GLuaFixer/AG/LexLint.ag" #-} showString "--[" . showString (replicate depth_ '-') . showChar '[' . showString comment_ . showChar ']' . showString (replicate depth_ '-') . showChar ']' $ "" {-# LINE 1005 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _str -> (case (({-# LINE 203 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos _str {-# LINE 1010 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_DashBlockComment_1 :: T_Token_1 sem_Token_DashBlockComment_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1027 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} DashBlockComment depth_ comment_ {-# LINE 1032 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1037 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1042 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1047 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 205 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax <> SyntaxUsed (Just _lhsImpos) Nothing {-# LINE 1052 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 206 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 1057 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _multilineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _multilineCommentSyntax {-# LINE 1062 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1067 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1072 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1077 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1082 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 207 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1087 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 207 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "--[[ ]]" "/* */" {-# LINE 1093 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 207 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 1098 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_DashBlockComment_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_SlashComment :: String -> T_Token sem_Token_SlashComment comment_ = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} SlashComment comment_ {-# LINE 1111 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 193 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1116 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _nextTokenPos -> (case (({-# LINE 141 "src/GLuaFixer/AG/LexLint.ag" #-} _nextTokenPos {-# LINE 1121 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_SlashComment_1 :: T_Token_1 sem_Token_SlashComment_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1138 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1143 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1148 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 195 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax <> SyntaxUsed Nothing (Just _lhsImpos) {-# LINE 1153 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 196 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 1158 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lineCommentSyntax -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lineCommentSyntax {-# LINE 1163 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1168 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1173 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1178 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1183 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1188 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 197 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1193 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 197 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "//" "--" {-# LINE 1199 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 197 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 1204 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_SlashComment_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) }) })) sem_Token_SlashBlockComment :: String -> T_Token sem_Token_SlashBlockComment comment_ = (\ _lhsInextTokenPos -> (case (({-# LINE 211 "src/GLuaFixer/AG/LexLint.ag" #-} showString "/*" . showString comment_ . showString "*/" $ "" {-# LINE 1217 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _str -> (case (({-# LINE 212 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos _str {-# LINE 1222 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_SlashBlockComment_1 :: T_Token_1 sem_Token_SlashBlockComment_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1239 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} SlashBlockComment comment_ {-# LINE 1244 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1249 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1254 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1259 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 214 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax <> SyntaxUsed Nothing (Just _lhsImpos) {-# LINE 1264 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 215 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 1269 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _multilineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _multilineCommentSyntax {-# LINE 1274 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1279 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1284 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1289 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1294 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 216 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1299 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 216 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "/* */" "--[[ ]]" {-# LINE 1305 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 216 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 1310 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_SlashBlockComment_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Semicolon :: T_Token sem_Token_Semicolon = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Semicolon {-# LINE 1322 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1327 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Semicolon_1 :: T_Token_1 sem_Token_Semicolon_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1344 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1349 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1354 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1359 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1364 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1369 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1374 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1379 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1384 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1389 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Semicolon_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TNumber :: String -> T_Token sem_Token_TNumber num_ = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TNumber num_ {-# LINE 1402 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1407 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TNumber_1 :: T_Token_1 sem_Token_TNumber_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1424 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1429 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1434 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1439 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1444 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1449 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1454 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1459 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1464 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1469 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TNumber_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_DQString :: String -> T_Token sem_Token_DQString str_ = (\ _lhsInextTokenPos -> (case (({-# LINE 224 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos $ "\"" <> str_ <> "\"" {-# LINE 1482 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_DQString_1 :: T_Token_1 sem_Token_DQString_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1499 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} DQString str_ {-# LINE 1504 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1509 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1514 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1519 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1524 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1529 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1534 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1539 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 226 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax <> SyntaxUsed (Just _lhsImpos) Nothing {-# LINE 1544 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 227 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 1549 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _strSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _strSyntax {-# LINE 1554 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 228 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1559 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 228 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "double quoted strings" "single quoted strings" {-# LINE 1565 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 228 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 1570 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_DQString_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) })) sem_Token_SQString :: String -> T_Token sem_Token_SQString str_ = (\ _lhsInextTokenPos -> (case (({-# LINE 233 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos $ "'" <> str_ <> "'" {-# LINE 1583 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_SQString_1 :: T_Token_1 sem_Token_SQString_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1600 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} SQString str_ {-# LINE 1605 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1610 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1615 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1620 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1625 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1630 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1635 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1640 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 236 "src/GLuaFixer/AG/LexLint.ag" #-} if isSingleChar str_ then Nothing else Just _lhsImpos {-# LINE 1645 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _usesSingleQuotedSyntax -> (case (({-# LINE 237 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax <> SyntaxUsed Nothing _usesSingleQuotedSyntax {-# LINE 1650 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 238 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 1655 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _strSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _strSyntax {-# LINE 1660 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 239 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1665 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 239 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "single quoted strings" "double quoted strings" {-# LINE 1671 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 239 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 1676 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_SQString_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) })) sem_Token_MLString :: String -> T_Token sem_Token_MLString str_ = (\ _lhsInextTokenPos -> (case (({-# LINE 243 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos str_ {-# LINE 1689 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_MLString_1 :: T_Token_1 sem_Token_MLString_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1706 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} MLString str_ {-# LINE 1711 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1716 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1721 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1726 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1731 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1736 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1741 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1746 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1751 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1756 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_MLString_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) })) sem_Token_TTrue :: T_Token sem_Token_TTrue = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TTrue {-# LINE 1768 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1773 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TTrue_1 :: T_Token_1 sem_Token_TTrue_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1790 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1795 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1800 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1805 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1810 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1815 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1820 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1825 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1830 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1835 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TTrue_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TFalse :: T_Token sem_Token_TFalse = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TFalse {-# LINE 1847 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1852 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TFalse_1 :: T_Token_1 sem_Token_TFalse_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1869 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1874 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1879 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1884 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1889 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1894 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1899 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1904 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1909 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1914 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TFalse_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Nil :: T_Token sem_Token_Nil = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Nil {-# LINE 1926 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 1931 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Nil_1 :: T_Token_1 sem_Token_Nil_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 1948 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 1953 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 1958 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 1963 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 1968 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 1973 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 1978 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 1983 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 1988 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 1993 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Nil_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_VarArg :: T_Token sem_Token_VarArg = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} VarArg {-# LINE 2005 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2010 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_VarArg_1 :: T_Token_1 sem_Token_VarArg_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2027 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2032 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2037 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2042 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2047 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2052 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2057 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2062 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2067 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2072 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_VarArg_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Plus :: T_Token sem_Token_Plus = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Plus {-# LINE 2084 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2089 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Plus_1 :: T_Token_1 sem_Token_Plus_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2106 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2111 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2116 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2121 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2126 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2131 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2136 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2141 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2146 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2151 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Plus_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Minus :: T_Token sem_Token_Minus = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Minus {-# LINE 2163 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2168 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Minus_1 :: T_Token_1 sem_Token_Minus_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2185 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2190 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2195 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2200 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2205 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2210 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2215 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2220 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2225 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2230 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Minus_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Multiply :: T_Token sem_Token_Multiply = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Multiply {-# LINE 2242 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2247 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Multiply_1 :: T_Token_1 sem_Token_Multiply_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2264 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2269 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2274 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2279 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2284 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2289 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2294 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2299 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2304 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2309 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Multiply_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Divide :: T_Token sem_Token_Divide = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Divide {-# LINE 2321 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2326 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Divide_1 :: T_Token_1 sem_Token_Divide_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2343 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2348 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2353 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2358 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2363 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2368 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2373 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2378 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2383 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2388 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Divide_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Modulus :: T_Token sem_Token_Modulus = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Modulus {-# LINE 2400 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2405 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Modulus_1 :: T_Token_1 sem_Token_Modulus_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2422 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2427 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2432 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2437 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2442 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2447 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2452 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2457 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2462 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2467 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Modulus_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Power :: T_Token sem_Token_Power = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Power {-# LINE 2479 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2484 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Power_1 :: T_Token_1 sem_Token_Power_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2501 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2506 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2511 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2516 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2521 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2526 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2531 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2536 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2541 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2546 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Power_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TEq :: T_Token sem_Token_TEq = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TEq {-# LINE 2558 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2563 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TEq_1 :: T_Token_1 sem_Token_TEq_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2580 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2585 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2590 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2595 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2600 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2605 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2610 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2615 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2620 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2625 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TEq_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TNEq :: T_Token sem_Token_TNEq = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TNEq {-# LINE 2637 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2642 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TNEq_1 :: T_Token_1 sem_Token_TNEq_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2659 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2664 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2669 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2674 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2679 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 282 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax <> SyntaxUsed (Just _lhsImpos) Nothing {-# LINE 2684 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 283 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 2689 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _neqSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _neqSyntax {-# LINE 2694 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2699 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2704 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2709 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 284 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2714 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 284 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "~=" "!=" {-# LINE 2720 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 284 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 2725 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_TNEq_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TCNEq :: T_Token sem_Token_TCNEq = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TCNEq {-# LINE 2737 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2742 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TCNEq_1 :: T_Token_1 sem_Token_TCNEq_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2759 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2764 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2769 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2774 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2779 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 288 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax <> SyntaxUsed Nothing (Just _lhsImpos) {-# LINE 2784 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 289 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 2789 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _neqSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _neqSyntax {-# LINE 2794 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2799 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2804 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2809 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 290 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2814 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 290 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "!=" "~=" {-# LINE 2820 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 290 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 2825 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_TCNEq_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TLEQ :: T_Token sem_Token_TLEQ = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TLEQ {-# LINE 2837 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2842 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TLEQ_1 :: T_Token_1 sem_Token_TLEQ_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2859 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2864 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2869 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2874 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2879 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2884 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2889 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2894 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2899 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2904 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TLEQ_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TGEQ :: T_Token sem_Token_TGEQ = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TGEQ {-# LINE 2916 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 2921 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TGEQ_1 :: T_Token_1 sem_Token_TGEQ_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 2938 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 2943 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 2948 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 2953 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 2958 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 2963 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 2968 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 2973 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 2978 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 2983 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TGEQ_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TLT :: T_Token sem_Token_TLT = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TLT {-# LINE 2995 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3000 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TLT_1 :: T_Token_1 sem_Token_TLT_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3017 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3022 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3027 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3032 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3037 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3042 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3047 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3052 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3057 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3062 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TLT_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_TGT :: T_Token sem_Token_TGT = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} TGT {-# LINE 3074 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3079 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_TGT_1 :: T_Token_1 sem_Token_TGT_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3096 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3101 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3106 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3111 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3116 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3121 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3126 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3131 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3136 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3141 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_TGT_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Equals :: T_Token sem_Token_Equals = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Equals {-# LINE 3153 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3158 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Equals_1 :: T_Token_1 sem_Token_Equals_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3175 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3180 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3185 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3190 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3195 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3200 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3205 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3210 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3215 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3220 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Equals_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Concatenate :: T_Token sem_Token_Concatenate = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Concatenate {-# LINE 3232 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3237 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Concatenate_1 :: T_Token_1 sem_Token_Concatenate_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3254 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3259 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3264 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3269 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3274 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3279 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3284 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3289 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3294 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3299 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Concatenate_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Colon :: T_Token sem_Token_Colon = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Colon {-# LINE 3311 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3316 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Colon_1 :: T_Token_1 sem_Token_Colon_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3333 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3338 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3343 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3348 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3353 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3358 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3363 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3368 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3373 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3378 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Colon_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Dot :: T_Token sem_Token_Dot = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Dot {-# LINE 3390 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3395 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Dot_1 :: T_Token_1 sem_Token_Dot_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3412 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3417 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3422 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3427 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3432 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3437 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3442 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3447 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3452 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3457 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Dot_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Comma :: T_Token sem_Token_Comma = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Comma {-# LINE 3469 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3474 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Comma_1 :: T_Token_1 sem_Token_Comma_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3496 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3501 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3506 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3511 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3516 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3521 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3526 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3531 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3536 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Comma_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Hash :: T_Token sem_Token_Hash = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Hash {-# LINE 3548 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3553 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Hash_1 :: T_Token_1 sem_Token_Hash_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3570 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3575 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3580 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3585 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3590 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3595 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3600 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3605 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3610 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3615 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Hash_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Not :: T_Token sem_Token_Not = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Not {-# LINE 3627 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3632 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Not_1 :: T_Token_1 sem_Token_Not_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3649 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3654 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3659 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3664 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3669 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3674 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 246 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax <> SyntaxUsed (Just _lhsImpos) Nothing {-# LINE 3679 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 247 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 3684 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _notSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _notSyntax {-# LINE 3689 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3694 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3699 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 248 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3704 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 248 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "not" "!" {-# LINE 3710 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 248 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 3715 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_Not_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_CNot :: T_Token sem_Token_CNot = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} CNot {-# LINE 3727 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3732 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_CNot_1 :: T_Token_1 sem_Token_CNot_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 3749 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3754 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3759 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3764 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3769 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3774 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 252 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax <> SyntaxUsed Nothing (Just _lhsImpos) {-# LINE 3779 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 253 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 3784 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _notSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _notSyntax {-# LINE 3789 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3794 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3799 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 254 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3804 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 254 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "!" "not" {-# LINE 3810 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 254 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 3815 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_CNot_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_And :: T_Token sem_Token_And = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} And {-# LINE 3827 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3832 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_And_1 :: T_Token_1 sem_Token_And_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 258 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax <> SyntaxUsed (Just _lhsImpos) Nothing {-# LINE 3849 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 259 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 3854 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _andSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _andSyntax {-# LINE 3859 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3864 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3869 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3874 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3879 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3884 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3889 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3894 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3899 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 260 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 3904 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 260 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "and" "&&" {-# LINE 3910 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 260 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 3915 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_And_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_CAnd :: T_Token sem_Token_CAnd = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} CAnd {-# LINE 3927 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 3932 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_CAnd_1 :: T_Token_1 sem_Token_CAnd_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 264 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax <> SyntaxUsed Nothing (Just _lhsImpos) {-# LINE 3949 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 265 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 3954 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _andSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _andSyntax {-# LINE 3959 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 3964 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 3969 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 3974 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 3979 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 3984 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 3989 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 3994 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 3999 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 266 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4004 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 266 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "&&" "and" {-# LINE 4010 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 266 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 4015 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_CAnd_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Or :: T_Token sem_Token_Or = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Or {-# LINE 4027 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4032 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Or_1 :: T_Token_1 sem_Token_Or_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4049 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4054 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4059 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4064 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4069 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4074 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4079 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 270 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax <> SyntaxUsed (Just _lhsImpos) Nothing {-# LINE 4084 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 271 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 4089 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _orSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _orSyntax {-# LINE 4094 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4099 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 272 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4104 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 272 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "or" "||" {-# LINE 4110 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 272 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 4115 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_Or_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_COr :: T_Token sem_Token_COr = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} COr {-# LINE 4127 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4132 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_COr_1 :: T_Token_1 sem_Token_COr_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4149 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4154 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4159 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4164 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4169 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4174 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4179 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 276 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax <> SyntaxUsed Nothing (Just _lhsImpos) {-# LINE 4184 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _combinedSyntaxUsed -> (case (({-# LINE 277 "src/GLuaFixer/AG/LexLint.ag" #-} resetIfInconsistent _combinedSyntaxUsed {-# LINE 4189 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _orSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _orSyntax {-# LINE 4194 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4199 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 278 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4204 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_syn -> (case (({-# LINE 278 "src/GLuaFixer/AG/LexLint.ag" #-} if not (lint_syntaxInconsistencies _lhsIconfig) then id else warnInconsistency _combinedSyntaxUsed $ SyntaxInconsistency "||" "or" {-# LINE 4210 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _warnings_augmented_f1 -> (case (({-# LINE 278 "src/GLuaFixer/AG/LexLint.ag" #-} foldr ($) _warnings_augmented_syn [_warnings_augmented_f1] {-# LINE 4215 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) }) }) }) }) })) in sem_Token_COr_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Function :: T_Token sem_Token_Function = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Function {-# LINE 4227 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4232 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Function_1 :: T_Token_1 sem_Token_Function_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4249 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4254 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4259 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4264 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4269 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4274 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4279 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4284 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4289 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4294 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Function_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Local :: T_Token sem_Token_Local = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Local {-# LINE 4306 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4311 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Local_1 :: T_Token_1 sem_Token_Local_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4328 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4333 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4338 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4343 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4348 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4353 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4358 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4363 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4368 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4373 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Local_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_If :: T_Token sem_Token_If = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} If {-# LINE 4385 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4390 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_If_1 :: T_Token_1 sem_Token_If_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4407 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4412 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4417 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4422 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4427 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4432 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4437 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4442 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4447 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4452 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_If_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Then :: T_Token sem_Token_Then = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Then {-# LINE 4464 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4469 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Then_1 :: T_Token_1 sem_Token_Then_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4486 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4496 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4501 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4506 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4511 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4516 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4521 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4526 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4531 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Then_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Elseif :: T_Token sem_Token_Elseif = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Elseif {-# LINE 4543 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4548 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Elseif_1 :: T_Token_1 sem_Token_Elseif_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4565 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4570 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4575 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4580 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4585 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4590 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4595 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4600 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4605 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4610 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Elseif_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Else :: T_Token sem_Token_Else = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Else {-# LINE 4622 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4627 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Else_1 :: T_Token_1 sem_Token_Else_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4644 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4649 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4654 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4659 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4664 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4669 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4674 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4679 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4684 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4689 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Else_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_For :: T_Token sem_Token_For = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} For {-# LINE 4701 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4706 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_For_1 :: T_Token_1 sem_Token_For_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4723 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4728 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4733 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4738 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4743 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4748 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4753 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4758 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4763 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4768 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_For_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_In :: T_Token sem_Token_In = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} In {-# LINE 4780 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4785 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_In_1 :: T_Token_1 sem_Token_In_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4802 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4807 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4812 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4817 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4822 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4827 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4832 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4837 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4842 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4847 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_In_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Do :: T_Token sem_Token_Do = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Do {-# LINE 4859 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4864 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Do_1 :: T_Token_1 sem_Token_Do_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4881 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4886 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4891 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4896 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4901 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4906 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4911 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4916 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 4921 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 4926 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Do_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_While :: T_Token sem_Token_While = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} While {-# LINE 4938 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 4943 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_While_1 :: T_Token_1 sem_Token_While_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 4960 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 4965 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 4970 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 4975 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 4980 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 4985 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 4990 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 4995 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5000 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5005 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_While_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Until :: T_Token sem_Token_Until = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Until {-# LINE 5017 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5022 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Until_1 :: T_Token_1 sem_Token_Until_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5039 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5044 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5049 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5054 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5059 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5064 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5069 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5074 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5079 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5084 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Until_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Repeat :: T_Token sem_Token_Repeat = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Repeat {-# LINE 5096 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5101 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Repeat_1 :: T_Token_1 sem_Token_Repeat_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5118 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5123 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5128 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5133 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5138 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5143 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5148 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5153 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5158 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5163 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Repeat_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Continue :: T_Token sem_Token_Continue = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Continue {-# LINE 5175 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5180 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Continue_1 :: T_Token_1 sem_Token_Continue_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5197 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5202 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5207 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5212 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5217 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5222 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5227 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5232 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5237 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5242 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Continue_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Break :: T_Token sem_Token_Break = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Break {-# LINE 5254 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5259 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Break_1 :: T_Token_1 sem_Token_Break_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5276 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5281 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5286 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5291 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5296 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5301 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5306 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5311 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5316 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5321 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Break_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Return :: T_Token sem_Token_Return = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Return {-# LINE 5333 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5338 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Return_1 :: T_Token_1 sem_Token_Return_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5355 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5360 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5365 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5370 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5375 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5380 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5385 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5390 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5395 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5400 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Return_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_End :: T_Token sem_Token_End = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} End {-# LINE 5412 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5417 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_End_1 :: T_Token_1 sem_Token_End_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5434 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5439 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5444 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5449 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5454 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5459 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5464 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5469 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5474 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5479 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_End_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_LRound :: T_Token sem_Token_LRound = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} LRound {-# LINE 5491 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5496 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_LRound_1 :: T_Token_1 sem_Token_LRound_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5513 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5518 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5523 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5528 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5533 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5538 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5543 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5548 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5553 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5558 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_LRound_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_RRound :: T_Token sem_Token_RRound = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} RRound {-# LINE 5570 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5575 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_RRound_1 :: T_Token_1 sem_Token_RRound_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5592 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5597 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5602 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5607 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5612 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5617 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5622 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5627 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5632 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5637 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_RRound_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_LCurly :: T_Token sem_Token_LCurly = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} LCurly {-# LINE 5649 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5654 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_LCurly_1 :: T_Token_1 sem_Token_LCurly_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5671 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5676 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5681 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5686 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5691 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5696 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5701 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5706 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5711 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5716 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_LCurly_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_RCurly :: T_Token sem_Token_RCurly = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} RCurly {-# LINE 5728 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5733 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_RCurly_1 :: T_Token_1 sem_Token_RCurly_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5750 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5755 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5760 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5765 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5770 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5775 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5780 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5785 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5790 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5795 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_RCurly_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_LSquare :: T_Token sem_Token_LSquare = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} LSquare {-# LINE 5807 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5812 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_LSquare_1 :: T_Token_1 sem_Token_LSquare_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5829 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5834 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5839 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5844 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5849 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5854 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5859 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5864 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5869 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5874 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_LSquare_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_RSquare :: T_Token sem_Token_RSquare = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} RSquare {-# LINE 5886 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 5891 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_RSquare_1 :: T_Token_1 sem_Token_RSquare_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5908 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5913 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 5918 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 5923 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 5928 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 5933 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 5938 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 5943 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 5948 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 5953 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_RSquare_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Label :: String -> String -> String -> T_Token sem_Token_Label whitespaceBefore_ lbl_ whitespaceAfter_ = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Label whitespaceBefore_ lbl_ whitespaceAfter_ {-# LINE 5968 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 294 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceStr _lhsInextTokenPos (show _copy ) {-# LINE 5973 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Label_1 :: T_Token_1 sem_Token_Label_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 5990 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 5995 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6000 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6005 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6010 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6015 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6020 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6025 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6030 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6035 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Label_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) })) sem_Token_Identifier :: String -> T_Token sem_Token_Identifier ident_ = (\ _lhsInextTokenPos -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} Identifier ident_ {-# LINE 6048 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _copy -> (case (({-# LINE 220 "src/GLuaFixer/AG/LexLint.ag" #-} customAdvanceToken _lhsInextTokenPos _copy {-# LINE 6053 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnextTokenPos -> (case ((let sem_Token_Identifier_1 :: T_Token_1 sem_Token_Identifier_1 = (\ _lhsIandSyntax _lhsIconfig _lhsIindentation _lhsIlineCommentSyntax _lhsImpos _lhsImultilineCommentSyntax _lhsIneqSyntax _lhsInotSyntax _lhsIorSyntax _lhsIstrSyntax -> (case (({-# LINE 135 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIandSyntax {-# LINE 6070 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOandSyntax -> (case (({-# LINE 127 "src/GLuaFixer/AG/LexLint.ag" #-} _copy {-# LINE 6075 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOcopy -> (case (({-# LINE 139 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIindentation {-# LINE 6080 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOindentation -> (case (({-# LINE 132 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIlineCommentSyntax {-# LINE 6085 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOlineCommentSyntax -> (case (({-# LINE 133 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsImultilineCommentSyntax {-# LINE 6090 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOmultilineCommentSyntax -> (case (({-# LINE 137 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIneqSyntax {-# LINE 6095 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOneqSyntax -> (case (({-# LINE 134 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsInotSyntax {-# LINE 6100 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOnotSyntax -> (case (({-# LINE 136 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIorSyntax {-# LINE 6105 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOorSyntax -> (case (({-# LINE 138 "src/GLuaFixer/AG/LexLint.ag" #-} _lhsIstrSyntax {-# LINE 6110 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOstrSyntax -> (case (({-# LINE 130 "src/GLuaFixer/AG/LexLint.ag" #-} [] {-# LINE 6115 "src/GLuaFixer/AG/LexLint.hs" #-} )) of { _lhsOwarnings -> ( _lhsOandSyntax,_lhsOcopy,_lhsOindentation,_lhsOlineCommentSyntax,_lhsOmultilineCommentSyntax,_lhsOneqSyntax,_lhsOnotSyntax,_lhsOorSyntax,_lhsOstrSyntax,_lhsOwarnings) }) }) }) }) }) }) }) }) }) })) in sem_Token_Identifier_1)) of { ( sem_Token_1) -> ( _lhsOnextTokenPos,sem_Token_1) }) }) }))