{-# 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)

-- | Output formats for logging
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)

-- | With the Space(Before|After)(Parenthesis|Bracket|Brace), it depends on the pretty print
-- settings whether the space is desired or not. This encodes what we ask the user to do.
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)

-- | Representation of the different kinds of issues that can be raised. Many of the arguments are
-- 'String', because this data type is a rewrite of what was previously directly rendered Strings.
-- Many of these Strings can later be rewritten to their own types if necessary.
data Issue
  = IssueParseError ParseError
  | -- From BadSequenceFinder

    -- | Reason
    Deprecated !String
  | Profanity
  | -- | message
    BeginnerMistake !String
  | -- | message
    WhitespaceStyle !String
  | SpaceAfterParenthesis !RemoveOrAddSpace
  | SpaceBeforeParenthesis !RemoveOrAddSpace
  | SpaceAfterBracket !RemoveOrAddSpace
  | SpaceBeforeBracket !RemoveOrAddSpace
  | SpaceAfterBrace !RemoveOrAddSpace
  | SpaceBeforeBrace !RemoveOrAddSpace
  | SpaceAfterComma !RemoveOrAddSpace
  | SpaceBeforeComma !RemoveOrAddSpace
  | -- Issues found in the lexicon (see LexLint.ag)
    TrailingWhitespace
  | InconsistentTabsSpaces
  | SyntaxInconsistency
      !String
      -- ^ First encountered
      !String
      -- ^ Second encountered
  | -- Line length limit (see LineLimitParser.hs)
    LineTooLong
  | -- Issues found in the AST (see ASTLint.ag)
    VariableShadows
      !String
      -- ^ Name of the variable being shadowed
      !Region
      -- ^ Definition location of variable being shadowed
  | GotoAsIdentifier
  | InconsistentVariableNaming
  | ScopePyramids
  | -- | Variable name
    UnusedVariable !String
  | AvoidGoto
  | EmptyDoBlock
  | EmptyWhileLoop
  | EmptyRepeat
  | EmptyIf
  | DoubleIf
  | EmptyFor
  | EmptyElseIf
  | EmptyElse
  | SelfInNonMeta
  | SelfEntity
  | SelfWeapon
  | UnnecessaryParentheses
  | -- | Alternative to using the negation
    SillyNegation !String
  | -- | The key that is duplicated
    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)

-- | Represents lint messages
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
"'."

-- | Shorthand title of an issue. Several issues may share the same title.
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
""

-- | Sort lint messages on file and then region
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))