{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module GLuaFixer.LintMessage where
import Control.Monad
import Data.Aeson
import Data.List (sortOn)
import Data.Maybe (isJust)
import GLua.AG.PrettyPrint (renderPSError, renderPos, renderRegion)
import GLua.AG.Token (Token)
import GLua.Position (LineColPos (..), Region (..))
import System.Environment (lookupEnv)
import Text.Parsec (ParseError)
data LogFormat = StandardLogFormat | GithubLogFormat
data LogFormatChoice = AutoLogFormatChoice | LogFormatChoice !LogFormat
instance Show LogFormat where
show :: LogFormat -> FilePath
show LogFormat
StandardLogFormat = FilePath
"standard"
show LogFormat
GithubLogFormat = FilePath
"github"
instance Show LogFormatChoice where
show :: LogFormatChoice -> FilePath
show (LogFormatChoice LogFormat
choice) = forall a. Show a => a -> FilePath
show LogFormat
choice
show LogFormatChoice
AutoLogFormatChoice = FilePath
"auto"
instance ToJSON LogFormat where
toJSON :: LogFormat -> Value
toJSON LogFormat
StandardLogFormat = Value
"standard"
toJSON LogFormat
GithubLogFormat = Value
"github"
instance ToJSON LogFormatChoice where
toJSON :: LogFormatChoice -> Value
toJSON (LogFormatChoice LogFormat
choice) = forall a. ToJSON a => a -> Value
toJSON LogFormat
choice
toJSON LogFormatChoice
AutoLogFormatChoice = Value
"auto"
instance FromJSON LogFormatChoice where
parseJSON :: Value -> Parser LogFormatChoice
parseJSON (String Text
logFormat) = case Text
logFormat of
Text
"standard" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LogFormat -> LogFormatChoice
LogFormatChoice LogFormat
StandardLogFormat
Text
"github" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LogFormat -> LogFormatChoice
LogFormatChoice LogFormat
GithubLogFormat
Text
"auto" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LogFormatChoice
AutoLogFormatChoice
Text
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Please use either \"auto\" \"standard\" or \"github\" but was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Text
logFormat)
parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero
data Severity = LintWarning | LintError
deriving (Severity -> Severity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq)
data RemoveOrAddSpace
= RemoveSpace
| AddSpace
deriving (RemoveOrAddSpace -> RemoveOrAddSpace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveOrAddSpace -> RemoveOrAddSpace -> Bool
$c/= :: RemoveOrAddSpace -> RemoveOrAddSpace -> Bool
== :: RemoveOrAddSpace -> RemoveOrAddSpace -> Bool
$c== :: RemoveOrAddSpace -> RemoveOrAddSpace -> Bool
Eq)
data Issue
= IssueParseError ParseError
|
Deprecated !String
| Profanity
|
BeginnerMistake !String
|
WhitespaceStyle !String
| SpaceAfterParenthesis !RemoveOrAddSpace
| SpaceBeforeParenthesis !RemoveOrAddSpace
| SpaceAfterBracket !RemoveOrAddSpace
| SpaceBeforeBracket !RemoveOrAddSpace
| SpaceAfterBrace !RemoveOrAddSpace
| SpaceBeforeBrace !RemoveOrAddSpace
| SpaceAfterComma !RemoveOrAddSpace
| SpaceBeforeComma !RemoveOrAddSpace
|
TrailingWhitespace
| InconsistentTabsSpaces
| SyntaxInconsistency
!String
!String
|
LineTooLong
|
VariableShadows
!String
!Region
| GotoAsIdentifier
| InconsistentVariableNaming
| ScopePyramids
|
UnusedVariable !String
| AvoidGoto
| EmptyDoBlock
| EmptyWhileLoop
| EmptyRepeat
| EmptyIf
| DoubleIf
| EmptyFor
| EmptyElseIf
| EmptyElse
| SelfInNonMeta
| SelfEntity
| SelfWeapon
| UnnecessaryParentheses
|
SillyNegation !String
|
DuplicateKeyInTable !Token
deriving (Issue -> Issue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue -> Issue -> Bool
$c/= :: Issue -> Issue -> Bool
== :: Issue -> Issue -> Bool
$c== :: Issue -> Issue -> Bool
Eq)
data LintMessage = LintMessage
{ LintMessage -> Severity
lintmsg_severity :: !Severity
, LintMessage -> Region
lintmsg_region :: !Region
, LintMessage -> Issue
lintmsg_message :: !Issue
, LintMessage -> FilePath
lintmsg_file :: !FilePath
}
deriving (LintMessage -> LintMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LintMessage -> LintMessage -> Bool
$c/= :: LintMessage -> LintMessage -> Bool
== :: LintMessage -> LintMessage -> Bool
$c== :: LintMessage -> LintMessage -> Bool
Eq)
instance Show LintMessage where
show :: LintMessage -> FilePath
show = LintMessage -> FilePath
formatLintMessageDefault
issueDescription :: Issue -> String
issueDescription :: Issue -> FilePath
issueDescription = \case
IssueParseError ParseError
parseError -> ParseError -> FilePath
renderPSError ParseError
parseError
Deprecated FilePath
reason -> FilePath
"Deprecated: " forall a. [a] -> [a] -> [a]
++ FilePath
reason
Issue
Profanity -> FilePath
"Watch your profanity"
BeginnerMistake FilePath
msg -> FilePath
msg
WhitespaceStyle FilePath
msg -> FilePath
"Style: " forall a. [a] -> [a] -> [a]
++ FilePath
msg
SpaceAfterParenthesis RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space after the parenthesis"
SpaceAfterParenthesis RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space after the parenthesis"
SpaceBeforeParenthesis RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space before the parenthesis"
SpaceBeforeParenthesis RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space before the parenthesis"
SpaceAfterBracket RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space after the bracket"
SpaceAfterBracket RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space after the bracket"
SpaceBeforeBracket RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space before the bracket"
SpaceBeforeBracket RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space before the bracket"
SpaceAfterBrace RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space after the brace"
SpaceAfterBrace RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space after the brace"
SpaceBeforeBrace RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space before the brace"
SpaceBeforeBrace RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space before the brace"
SpaceAfterComma RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space after the comma"
SpaceAfterComma RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space after the comma"
SpaceBeforeComma RemoveOrAddSpace
RemoveSpace -> FilePath
"Style: Please remove the space before the comma"
SpaceBeforeComma RemoveOrAddSpace
AddSpace -> FilePath
"Style: Please add a space before the comma"
Issue
TrailingWhitespace -> FilePath
"Trailing whitespace"
Issue
InconsistentTabsSpaces -> FilePath
"Inconsistent use of tabs and spaces for indentation"
SyntaxInconsistency FilePath
firstEncountered FilePath
secondEncountered ->
FilePath
"Inconsistent use of '" forall a. [a] -> [a] -> [a]
++ FilePath
firstEncountered forall a. [a] -> [a] -> [a]
++ FilePath
"' and '" forall a. [a] -> [a] -> [a]
++ FilePath
secondEncountered forall a. [a] -> [a] -> [a]
++ FilePath
"'"
Issue
LineTooLong -> FilePath
"Style: Line too long"
VariableShadows FilePath
lbl (Region LineColPos
start LineColPos
_) ->
FilePath
"Variable '" forall a. [a] -> [a] -> [a]
++ FilePath
lbl forall a. [a] -> [a] -> [a]
++ FilePath
"' shadows existing binding, defined at " forall a. [a] -> [a] -> [a]
++ LineColPos -> FilePath
renderPos LineColPos
start
Issue
GotoAsIdentifier ->
FilePath
"Don't use 'goto' as an identifier, later versions of Lua will confuse it with the goto keyword."
Issue
InconsistentVariableNaming ->
FilePath
"Inconsistent variable naming! There are variables that start with a lowercase letter, as well as ones that start with an uppercase letter. Please decide on one style."
Issue
ScopePyramids ->
FilePath
"Are you Egyptian? What's with these fucking scope pyramids!?"
UnusedVariable FilePath
varName ->
FilePath
"Unused variable: " forall a. [a] -> [a] -> [a]
++ FilePath
varName
Issue
AvoidGoto ->
FilePath
"Don't use labels and gotos unless you're jumping out of multiple loops."
Issue
EmptyDoBlock -> FilePath
"Empty do block"
Issue
EmptyWhileLoop -> FilePath
"Empty while loop"
Issue
EmptyRepeat -> FilePath
"Empty repeat statement"
Issue
EmptyIf -> FilePath
"Empty if statement"
Issue
DoubleIf ->
FilePath
"Double if statement. Please combine the condition of this if statement with that of the outer if statement using `and`."
Issue
EmptyFor -> FilePath
"Empty for loop"
Issue
EmptyElseIf -> FilePath
"Empty elseif statement"
Issue
EmptyElse -> FilePath
"Empty else statement"
Issue
SelfInNonMeta ->
FilePath
"Don't use self in a non-metafunction"
Issue
SelfEntity ->
FilePath
"'self.Entity' is the same as just 'self' in SENTs"
Issue
SelfWeapon ->
FilePath
"'self.Weapon' is the same as just 'self' in SWEPs"
Issue
UnnecessaryParentheses -> FilePath
"Unnecessary parentheses"
SillyNegation FilePath
alternative ->
FilePath
"Silly negation. Use '" forall a. [a] -> [a] -> [a]
++ FilePath
alternative forall a. [a] -> [a] -> [a]
++ FilePath
"'"
DuplicateKeyInTable Token
keyToken ->
FilePath
"Duplicate key in table: '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Token
keyToken forall a. [a] -> [a] -> [a]
++ FilePath
"'."
issueTitle :: Issue -> String
issueTitle :: Issue -> FilePath
issueTitle = \case
IssueParseError ParseError
_ -> FilePath
"Parse error"
Deprecated FilePath
_ -> FilePath
"Deprecated"
Issue
Profanity -> FilePath
"Profanity"
BeginnerMistake FilePath
_ -> FilePath
"Beginner mistake"
WhitespaceStyle FilePath
_ -> FilePath
"Whitespace style"
Issue
TrailingWhitespace -> FilePath
"Trailing whitespace"
SpaceAfterParenthesis RemoveOrAddSpace
_ -> FilePath
"Space after parenthesis"
SpaceBeforeParenthesis RemoveOrAddSpace
_ -> FilePath
"Space before parenthesis"
SpaceAfterBracket RemoveOrAddSpace
_ -> FilePath
"Space after bracket"
SpaceBeforeBracket RemoveOrAddSpace
_ -> FilePath
"Space before bracket"
SpaceAfterBrace RemoveOrAddSpace
_ -> FilePath
"Space after brace"
SpaceBeforeBrace RemoveOrAddSpace
_ -> FilePath
"Space before brace"
SpaceAfterComma RemoveOrAddSpace
_ -> FilePath
"Space after comma"
SpaceBeforeComma RemoveOrAddSpace
_ -> FilePath
"Space before comma"
Issue
InconsistentTabsSpaces -> FilePath
"Syntax inconsistency"
SyntaxInconsistency FilePath
_ FilePath
_ -> FilePath
"Syntax inconsistency"
Issue
LineTooLong -> FilePath
"Line too long"
VariableShadows FilePath
_ Region
_ -> FilePath
"Shadowing"
Issue
GotoAsIdentifier -> FilePath
"Goto"
Issue
InconsistentVariableNaming -> FilePath
"Variable inconsistency"
Issue
ScopePyramids -> FilePath
"Scope depth"
UnusedVariable FilePath
_ -> FilePath
"Unused variable"
Issue
AvoidGoto -> FilePath
"Goto"
Issue
EmptyDoBlock -> FilePath
"Empty block"
Issue
EmptyWhileLoop -> FilePath
"Empty block"
Issue
EmptyRepeat -> FilePath
"Empty block"
Issue
EmptyIf -> FilePath
"Empty block"
Issue
DoubleIf -> FilePath
"Double if-statement"
Issue
EmptyFor -> FilePath
"Empty block"
Issue
EmptyElseIf -> FilePath
"Empty block"
Issue
EmptyElse -> FilePath
"Empty block"
Issue
SelfInNonMeta -> FilePath
"Bad self"
Issue
SelfEntity -> FilePath
"Deprecated"
Issue
SelfWeapon -> FilePath
"Deprecated"
Issue
UnnecessaryParentheses -> FilePath
"Unnecessary parentheses"
SillyNegation FilePath
_ -> FilePath
"Unnecessary negation"
DuplicateKeyInTable Token
_ -> FilePath
"Duplicate key"
logFormatChoiceToLogFormat :: LogFormatChoice -> IO LogFormat
logFormatChoiceToLogFormat :: LogFormatChoice -> IO LogFormat
logFormatChoiceToLogFormat = \case
LogFormatChoice LogFormat
format -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LogFormat
format
LogFormatChoice
AutoLogFormatChoice -> do
Bool
actionsExists <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GITHUB_ACTIONS"
Bool
workflowExists <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"GITHUB_WORKFLOW"
if Bool
actionsExists Bool -> Bool -> Bool
&& Bool
workflowExists
then forall (f :: * -> *) a. Applicative f => a -> f a
pure LogFormat
GithubLogFormat
else forall (f :: * -> *) a. Applicative f => a -> f a
pure LogFormat
StandardLogFormat
formatLintMessage :: LogFormat -> LintMessage -> String
formatLintMessage :: LogFormat -> LintMessage -> FilePath
formatLintMessage LogFormat
StandardLogFormat LintMessage
lintMsg = LintMessage -> FilePath
formatLintMessageDefault LintMessage
lintMsg
formatLintMessage LogFormat
GithubLogFormat LintMessage
lintMsg = LintMessage -> FilePath
formatLintMessageGithub LintMessage
lintMsg
formatLintMessageDefault :: LintMessage -> String
formatLintMessageDefault :: LintMessage -> FilePath
formatLintMessageDefault (LintMessage Severity
severity Region
region Issue
msg FilePath
file) =
let
level :: FilePath
level = case Severity
severity of
Severity
LintWarning -> FilePath
"Warning"
Severity
LintError -> FilePath
"Error"
in
FilePath -> ShowS
showString FilePath
file
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
": ["
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"] "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString (Region -> FilePath
renderRegion Region
region)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
": "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString (Issue -> FilePath
issueDescription Issue
msg)
forall a b. (a -> b) -> a -> b
$ FilePath
""
formatLintMessageGithub :: LintMessage -> String
formatLintMessageGithub :: LintMessage -> FilePath
formatLintMessageGithub (LintMessage Severity
severity (Region (LineColPos Int
line Int
col Int
_) (LineColPos Int
endLine Int
endCol Int
_)) Issue
msg FilePath
file) =
let
level :: FilePath
level = case Severity
severity of
Severity
LintWarning -> FilePath
"warning"
Severity
LintError -> FilePath
"error"
in
FilePath -> ShowS
showString FilePath
"::"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
" file="
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
file
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
",line="
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Enum a => a -> a
succ Int
line)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
",col="
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Enum a => a -> a
succ Int
col)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
",endLine="
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Enum a => a -> a
succ Int
endLine)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
",endColumn="
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Enum a => a -> a
succ Int
endCol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
",title="
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (Issue -> FilePath
issueTitle Issue
msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"::"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString (Issue -> FilePath
issueDescription Issue
msg)
forall a b. (a -> b) -> a -> b
$ FilePath
""
sortLintMessages :: [LintMessage] -> [LintMessage]
sortLintMessages :: [LintMessage] -> [LintMessage]
sortLintMessages = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(LintMessage Severity
_ Region
rg Issue
_ FilePath
f) -> (FilePath
f, Region
rg))