{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module GLuaFixer.LintMessage where

import Control.Monad
import Data.Aeson
import Data.List (sortOn)
import Data.Maybe (isJust)
import System.Environment (lookupEnv)
import Text.Parsec (ParseError)
import Text.ParserCombinators.UU.BasicInstances hiding (msgs)

import GLua.AG.PrettyPrint
import GLua.AG.Token

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