{-
    Copyright 2012-2022 Vidar Holen

    This file is part of ShellCheck.
    https://www.shellcheck.net

    ShellCheck is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    ShellCheck is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
module ShellCheck.Analyzer (analyzeScript, ShellCheck.Analyzer.optionalChecks) where

import ShellCheck.Analytics
import ShellCheck.AnalyzerLib
import ShellCheck.Interface
import Data.List
import Data.Monoid
import qualified ShellCheck.Checks.Commands
import qualified ShellCheck.Checks.ControlFlow
import qualified ShellCheck.Checks.Custom
import qualified ShellCheck.Checks.ShellSupport


-- TODO: Clean up the cruft this is layered on
analyzeScript :: AnalysisSpec -> AnalysisResult
analyzeScript :: AnalysisSpec -> AnalysisResult
analyzeScript AnalysisSpec
spec = AnalysisResult
newAnalysisResult {
    arComments =
        filterByAnnotation spec params . nub $
            runChecker params (checkers spec params)
}
  where
    params :: Parameters
params = AnalysisSpec -> Parameters
makeParameters AnalysisSpec
spec

checkers :: AnalysisSpec -> Parameters -> Checker
checkers AnalysisSpec
spec Parameters
params = [Checker] -> Checker
forall a. Monoid a => [a] -> a
mconcat ([Checker] -> Checker) -> [Checker] -> Checker
forall a b. (a -> b) -> a -> b
$ ((Parameters -> Checker) -> Checker)
-> [Parameters -> Checker] -> [Checker]
forall a b. (a -> b) -> [a] -> [b]
map ((Parameters -> Checker) -> Parameters -> Checker
forall a b. (a -> b) -> a -> b
$ Parameters
params) [
    AnalysisSpec -> Parameters -> Checker
ShellCheck.Analytics.checker AnalysisSpec
spec,
    AnalysisSpec -> Parameters -> Checker
ShellCheck.Checks.Commands.checker AnalysisSpec
spec,
    AnalysisSpec -> Parameters -> Checker
ShellCheck.Checks.ControlFlow.checker AnalysisSpec
spec,
    Parameters -> Checker
ShellCheck.Checks.Custom.checker,
    Parameters -> Checker
ShellCheck.Checks.ShellSupport.checker
    ]

optionalChecks :: [CheckDescription]
optionalChecks = [[CheckDescription]] -> [CheckDescription]
forall a. Monoid a => [a] -> a
mconcat ([[CheckDescription]] -> [CheckDescription])
-> [[CheckDescription]] -> [CheckDescription]
forall a b. (a -> b) -> a -> b
$ [
    [CheckDescription]
ShellCheck.Analytics.optionalChecks,
    [CheckDescription]
ShellCheck.Checks.Commands.optionalChecks,
    [CheckDescription]
ShellCheck.Checks.ControlFlow.optionalChecks
    ]