{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module GLuaFixer.LintSettings where

import Control.Applicative ((<|>))
import Control.Monad (MonadPlus (mzero))
import Data.Aeson (
  FromJSON (parseJSON),
  KeyValue ((.=)),
  ToJSON (toJSON),
  Value (Object),
  object,
  (.!=),
  (.:?),
 )
import Data.String (IsString)
import GLua.AG.PrettyPrint (PrettyPrintConfig (..))
import GLuaFixer.LintMessage (
  LogFormatChoice (AutoLogFormatChoice),
 )

-- | Indentation used for pretty printing code
newtype Indentation = Indentation {Indentation -> String
unIndentation :: String}
  deriving (String -> Indentation
forall a. (String -> a) -> IsString a
fromString :: String -> Indentation
$cfromString :: String -> Indentation
IsString)
  deriving newtype (Int -> Indentation -> String -> String
[Indentation] -> String -> String
Indentation -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Indentation] -> String -> String
$cshowList :: [Indentation] -> String -> String
show :: Indentation -> String
$cshow :: Indentation -> String
showsPrec :: Int -> Indentation -> String -> String
$cshowsPrec :: Int -> Indentation -> String -> String
Show)

-- | Whether a file is read from stdin or from files
data StdInOrFiles
  = UseStdIn
  | UseFiles [FilePath]
  deriving (Int -> StdInOrFiles -> String -> String
[StdInOrFiles] -> String -> String
StdInOrFiles -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [StdInOrFiles] -> String -> String
$cshowList :: [StdInOrFiles] -> String -> String
show :: StdInOrFiles -> String
$cshow :: StdInOrFiles -> String
showsPrec :: Int -> StdInOrFiles -> String -> String
$cshowsPrec :: Int -> StdInOrFiles -> String -> String
Show)

-- | Convert a string to StdInOrFiles
parseStdInOrFiles :: String -> StdInOrFiles
parseStdInOrFiles :: String -> StdInOrFiles
parseStdInOrFiles String
"stdin" = StdInOrFiles
UseStdIn
parseStdInOrFiles String
other = [String] -> StdInOrFiles
UseFiles [String
other]

data LintSettings = LintSettings
  { LintSettings -> Int
lint_maxScopeDepth :: !Int
  , LintSettings -> Bool
lint_syntaxErrors :: !Bool
  , LintSettings -> Bool
lint_syntaxInconsistencies :: !Bool
  , LintSettings -> Bool
lint_deprecated :: !Bool
  , LintSettings -> Bool
lint_trailingWhitespace :: !Bool
  , LintSettings -> Bool
lint_whitespaceStyle :: !Bool
  , LintSettings -> Bool
lint_beginnerMistakes :: !Bool
  , LintSettings -> Bool
lint_emptyBlocks :: !Bool
  , LintSettings -> Bool
lint_shadowing :: !Bool
  , LintSettings -> Bool
lint_gotos :: !Bool
  , LintSettings -> Bool
lint_goto_identifier :: !Bool
  , LintSettings -> Bool
lint_doubleNegations :: !Bool
  , LintSettings -> Bool
lint_redundantIfStatements :: !Bool
  , LintSettings -> Bool
lint_redundantParentheses :: !Bool
  , LintSettings -> Bool
lint_duplicateTableKeys :: !Bool
  , LintSettings -> Bool
lint_profanity :: !Bool
  , LintSettings -> Bool
lint_unusedVars :: !Bool
  , LintSettings -> Bool
lint_unusedParameters :: !Bool
  , LintSettings -> Bool
lint_unusedLoopVars :: !Bool
  , LintSettings -> Bool
lint_inconsistentVariableStyle :: !Bool
  , LintSettings -> Bool
lint_spaceBetweenParens :: !Bool
  , LintSettings -> Bool
lint_spaceBetweenBrackets :: !Bool
  , LintSettings -> Bool
lint_spaceBetweenBraces :: !Bool
  , LintSettings -> Bool
lint_spaceBeforeComma :: !Bool
  , LintSettings -> Bool
lint_spaceAfterComma :: !Bool
  , LintSettings -> Int
lint_maxLineLength :: !Int
  , LintSettings -> [String]
lint_ignoreFiles :: ![String]
  , LintSettings -> Bool
prettyprint_spaceBetweenParens :: !Bool
  , LintSettings -> Bool
prettyprint_spaceBetweenBrackets :: !Bool
  , LintSettings -> Bool
prettyprint_spaceBetweenBraces :: !Bool
  , LintSettings -> Bool
prettyprint_spaceEmptyParens :: !Bool
  , LintSettings -> Bool
prettyprint_spaceEmptyBraces :: !Bool
  , LintSettings -> Bool
prettyprint_spaceAfterLabel :: !Bool
  , LintSettings -> Bool
prettyprint_spaceBeforeComma :: !Bool
  , LintSettings -> Bool
prettyprint_spaceAfterComma :: !Bool
  , LintSettings -> Bool
prettyprint_semicolons :: !Bool
  , LintSettings -> Bool
prettyprint_cStyle :: !Bool
  , LintSettings -> Bool
prettyprint_removeRedundantParens :: !Bool
  , LintSettings -> Bool
prettyprint_minimizeParens :: !Bool
  , LintSettings -> Bool
prettyprint_assumeOperatorAssociativity :: !Bool
  , LintSettings -> String
prettyprint_indentation :: !String
  , LintSettings -> LogFormatChoice
log_format :: !LogFormatChoice
  }
  deriving (Int -> LintSettings -> String -> String
[LintSettings] -> String -> String
LintSettings -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LintSettings] -> String -> String
$cshowList :: [LintSettings] -> String -> String
show :: LintSettings -> String
$cshow :: LintSettings -> String
showsPrec :: Int -> LintSettings -> String -> String
$cshowsPrec :: Int -> LintSettings -> String -> String
Show)

defaultLintSettings :: LintSettings
defaultLintSettings :: LintSettings
defaultLintSettings =
  LintSettings
    { lint_maxScopeDepth :: Int
lint_maxScopeDepth = Int
7
    , lint_syntaxErrors :: Bool
lint_syntaxErrors = Bool
True
    , lint_syntaxInconsistencies :: Bool
lint_syntaxInconsistencies = Bool
True
    , lint_deprecated :: Bool
lint_deprecated = Bool
True
    , lint_trailingWhitespace :: Bool
lint_trailingWhitespace = Bool
True
    , lint_whitespaceStyle :: Bool
lint_whitespaceStyle = Bool
True
    , lint_beginnerMistakes :: Bool
lint_beginnerMistakes = Bool
True
    , lint_emptyBlocks :: Bool
lint_emptyBlocks = Bool
True
    , lint_shadowing :: Bool
lint_shadowing = Bool
True
    , lint_gotos :: Bool
lint_gotos = Bool
True
    , lint_goto_identifier :: Bool
lint_goto_identifier = Bool
True
    , lint_doubleNegations :: Bool
lint_doubleNegations = Bool
True
    , lint_redundantIfStatements :: Bool
lint_redundantIfStatements = Bool
True
    , lint_redundantParentheses :: Bool
lint_redundantParentheses = Bool
True
    , lint_duplicateTableKeys :: Bool
lint_duplicateTableKeys = Bool
True
    , lint_profanity :: Bool
lint_profanity = Bool
True
    , lint_unusedVars :: Bool
lint_unusedVars = Bool
True
    , lint_unusedParameters :: Bool
lint_unusedParameters = Bool
False
    , lint_unusedLoopVars :: Bool
lint_unusedLoopVars = Bool
False
    , lint_inconsistentVariableStyle :: Bool
lint_inconsistentVariableStyle = Bool
False
    , lint_spaceBetweenParens :: Bool
lint_spaceBetweenParens = Bool
False
    , lint_spaceBetweenBrackets :: Bool
lint_spaceBetweenBrackets = Bool
False
    , lint_spaceBetweenBraces :: Bool
lint_spaceBetweenBraces = Bool
False
    , lint_spaceBeforeComma :: Bool
lint_spaceBeforeComma = Bool
False
    , lint_spaceAfterComma :: Bool
lint_spaceAfterComma = Bool
False
    , lint_maxLineLength :: Int
lint_maxLineLength = Int
0
    , lint_ignoreFiles :: [String]
lint_ignoreFiles = []
    , prettyprint_spaceBetweenParens :: Bool
prettyprint_spaceBetweenParens = Bool
False
    , prettyprint_spaceBetweenBrackets :: Bool
prettyprint_spaceBetweenBrackets = Bool
False
    , prettyprint_spaceBetweenBraces :: Bool
prettyprint_spaceBetweenBraces = Bool
False
    , prettyprint_spaceEmptyParens :: Bool
prettyprint_spaceEmptyParens = Bool
True
    , prettyprint_spaceEmptyBraces :: Bool
prettyprint_spaceEmptyBraces = Bool
True
    , prettyprint_spaceAfterLabel :: Bool
prettyprint_spaceAfterLabel = Bool
False
    , prettyprint_spaceBeforeComma :: Bool
prettyprint_spaceBeforeComma = Bool
False
    , prettyprint_spaceAfterComma :: Bool
prettyprint_spaceAfterComma = Bool
True
    , prettyprint_semicolons :: Bool
prettyprint_semicolons = Bool
False
    , prettyprint_cStyle :: Bool
prettyprint_cStyle = Bool
False
    , prettyprint_removeRedundantParens :: Bool
prettyprint_removeRedundantParens = Bool
True
    , prettyprint_minimizeParens :: Bool
prettyprint_minimizeParens = Bool
False
    , prettyprint_assumeOperatorAssociativity :: Bool
prettyprint_assumeOperatorAssociativity = Bool
True
    , prettyprint_indentation :: String
prettyprint_indentation = String
"    "
    , log_format :: LogFormatChoice
log_format = LogFormatChoice
AutoLogFormatChoice
    }

instance FromJSON LintSettings where
  parseJSON :: Value -> Parser LintSettings
parseJSON (Object Object
v) =
    Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Int
-> [String]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> String
-> LogFormatChoice
-> LintSettings
LintSettings
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_maxScopeDepth" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Int
lint_maxScopeDepth LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_syntaxErrors" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_syntaxErrors LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_syntaxInconsistencies" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_syntaxInconsistencies LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_deprecated" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_deprecated LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_trailingWhitespace" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_trailingWhitespace LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_whitespaceStyle" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_whitespaceStyle LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_beginnerMistakes" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_beginnerMistakes LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_emptyBlocks" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_emptyBlocks LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_shadowing" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_shadowing LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_gotos" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_gotos LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_goto_identifier" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_goto_identifier LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_doubleNegations" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_doubleNegations LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_redundantIfStatements" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_redundantIfStatements LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_redundantParentheses" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_redundantParentheses LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_duplicateTableKeys" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_duplicateTableKeys LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_profanity" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_profanity LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_unusedVars" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_unusedVars LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_unusedParameters" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_unusedParameters LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_unusedLoopVars" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_unusedLoopVars LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_inconsistentVariableStyle" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_inconsistentVariableStyle LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      -- Backwards compatible change: accept both the newer spaceBetween and the older
      -- spaceAfter
      ( Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceBetweenParens" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceBetweenParens LintSettings
defaultLintSettings
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceAfterParens" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceBetweenParens LintSettings
defaultLintSettings
      )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceBetweenBrackets" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceBetweenBrackets LintSettings
defaultLintSettings
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceAfterBrackets" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceBetweenBrackets LintSettings
defaultLintSettings
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceBetweenBraces" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceBetweenBraces LintSettings
defaultLintSettings
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceAfterBraces" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceBetweenBraces LintSettings
defaultLintSettings
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceBeforeComma" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceBeforeComma LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_spaceAfterComma" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
lint_spaceAfterComma LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_maxLineLength" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Int
lint_maxLineLength LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lint_ignoreFiles" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> [String]
lint_ignoreFiles LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceBetweenParens" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceBetweenParens LintSettings
defaultLintSettings
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceAfterParens" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceBetweenParens LintSettings
defaultLintSettings
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceBetweenBrackets" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceBetweenBrackets LintSettings
defaultLintSettings
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceAfterBrackets" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceBetweenBrackets LintSettings
defaultLintSettings
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceBetweenBraces" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceBetweenBraces LintSettings
defaultLintSettings
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceAfterBraces" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceBetweenBraces LintSettings
defaultLintSettings
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceEmptyParens" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceEmptyParens LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceEmptyBraces" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceEmptyBraces LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceAfterLabel" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceAfterLabel LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceBeforeComma" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceBeforeComma LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_spaceAfterComma" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_spaceAfterComma LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_semicolons" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_semicolons LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_cStyle" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_cStyle LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_removeRedundantParens" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_removeRedundantParens LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_minimizeParens" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_minimizeParens LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_assumeOperatorAssociativity" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> Bool
prettyprint_assumeOperatorAssociativity LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prettyprint_indentation" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> String
prettyprint_indentation LintSettings
defaultLintSettings
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"log_format" forall a. Parser (Maybe a) -> a -> Parser a
.!= LintSettings -> LogFormatChoice
log_format LintSettings
defaultLintSettings
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

lint2ppSetting :: LintSettings -> PrettyPrintConfig
lint2ppSetting :: LintSettings -> PrettyPrintConfig
lint2ppSetting LintSettings
ls =
  PPConfig
    { spaceAfterParens :: Bool
spaceAfterParens = LintSettings -> Bool
prettyprint_spaceBetweenParens LintSettings
ls
    , spaceAfterBrackets :: Bool
spaceAfterBrackets = LintSettings -> Bool
prettyprint_spaceBetweenBrackets LintSettings
ls
    , spaceAfterBraces :: Bool
spaceAfterBraces = LintSettings -> Bool
prettyprint_spaceBetweenBraces LintSettings
ls
    , spaceEmptyParens :: Bool
spaceEmptyParens = LintSettings -> Bool
prettyprint_spaceEmptyParens LintSettings
ls
    , spaceEmptyBraces :: Bool
spaceEmptyBraces = LintSettings -> Bool
prettyprint_spaceEmptyBraces LintSettings
ls
    , spaceAfterLabel :: Bool
spaceAfterLabel = LintSettings -> Bool
prettyprint_spaceAfterLabel LintSettings
ls
    , spaceBeforeComma :: Bool
spaceBeforeComma = LintSettings -> Bool
prettyprint_spaceBeforeComma LintSettings
ls
    , spaceAfterComma :: Bool
spaceAfterComma = LintSettings -> Bool
prettyprint_spaceAfterComma LintSettings
ls
    , semicolons :: Bool
semicolons = LintSettings -> Bool
prettyprint_semicolons LintSettings
ls
    , cStyle :: Bool
cStyle = LintSettings -> Bool
prettyprint_cStyle LintSettings
ls
    , removeRedundantParens :: Bool
removeRedundantParens = LintSettings -> Bool
prettyprint_removeRedundantParens LintSettings
ls
    , minimizeParens :: Bool
minimizeParens = LintSettings -> Bool
prettyprint_minimizeParens LintSettings
ls
    , assumeOperatorAssociativity :: Bool
assumeOperatorAssociativity = LintSettings -> Bool
prettyprint_assumeOperatorAssociativity LintSettings
ls
    , indentation :: String
indentation = LintSettings -> String
prettyprint_indentation LintSettings
ls
    }

instance ToJSON LintSettings where
  toJSON :: LintSettings -> Value
toJSON LintSettings
ls =
    [Pair] -> Value
object
      [ Key
"lint_maxScopeDepth" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Int
lint_maxScopeDepth LintSettings
ls
      , Key
"lint_syntaxErrors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_syntaxErrors LintSettings
ls
      , Key
"lint_syntaxInconsistencies" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_syntaxInconsistencies LintSettings
ls
      , Key
"lint_deprecated" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_deprecated LintSettings
ls
      , Key
"lint_trailingWhitespace" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_trailingWhitespace LintSettings
ls
      , Key
"lint_whitespaceStyle" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_whitespaceStyle LintSettings
ls
      , Key
"lint_beginnerMistakes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_beginnerMistakes LintSettings
ls
      , Key
"lint_emptyBlocks" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_emptyBlocks LintSettings
ls
      , Key
"lint_shadowing" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_shadowing LintSettings
ls
      , Key
"lint_gotos" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_gotos LintSettings
ls
      , Key
"lint_goto_identifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_goto_identifier LintSettings
ls
      , Key
"lint_doubleNegations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_doubleNegations LintSettings
ls
      , Key
"lint_redundantIfStatements" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_redundantIfStatements LintSettings
ls
      , Key
"lint_redundantParentheses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_redundantParentheses LintSettings
ls
      , Key
"lint_duplicateTableKeys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_duplicateTableKeys LintSettings
ls
      , Key
"lint_profanity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_profanity LintSettings
ls
      , Key
"lint_unusedVars" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_unusedVars LintSettings
ls
      , Key
"lint_unusedParameters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_unusedParameters LintSettings
ls
      , Key
"lint_unusedLoopVars" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_unusedLoopVars LintSettings
ls
      , Key
"lint_inconsistentVariableStyle" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_inconsistentVariableStyle LintSettings
ls
      , Key
"lint_spaceBetweenParens" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_spaceBetweenParens LintSettings
ls
      , Key
"lint_spaceBetweenBrackets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_spaceBetweenBrackets LintSettings
ls
      , Key
"lint_spaceBetweenBraces" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
lint_spaceBetweenBraces LintSettings
ls
      , Key
"lint_maxLineLength" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Int
lint_maxLineLength LintSettings
ls
      , Key
"lint_ignoreFiles" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> [String]
lint_ignoreFiles LintSettings
ls
      , Key
"prettyprint_spaceBetweenParens" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceBetweenParens LintSettings
ls
      , Key
"prettyprint_spaceBetweenBrackets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceBetweenBrackets LintSettings
ls
      , Key
"prettyprint_spaceBetweenBraces" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceBetweenBraces LintSettings
ls
      , Key
"prettyprint_spaceEmptyParens" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceEmptyParens LintSettings
ls
      , Key
"prettyprint_spaceEmptyBraces" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceEmptyBraces LintSettings
ls
      , Key
"prettyprint_spaceAfterLabel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceAfterLabel LintSettings
ls
      , Key
"prettyprint_spaceBeforeComma" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceBeforeComma LintSettings
ls
      , Key
"prettyprint_spaceAfterComma" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_spaceAfterComma LintSettings
ls
      , Key
"prettyprint_semicolons" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_semicolons LintSettings
ls
      , Key
"prettyprint_cStyle" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_cStyle LintSettings
ls
      , Key
"prettyprint_removeRedundantParens" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_removeRedundantParens LintSettings
ls
      , Key
"prettyprint_minimizeParens" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_minimizeParens LintSettings
ls
      , Key
"prettyprint_assumeOperatorAssociativity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> Bool
prettyprint_assumeOperatorAssociativity LintSettings
ls
      , Key
"prettyprint_indentation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> String
prettyprint_indentation LintSettings
ls
      , Key
"log_format" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LintSettings -> LogFormatChoice
log_format LintSettings
ls
      ]