{-
    Copyright 2012-2019 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/>.
-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module ShellCheck.Interface
    (
    SystemInterface(..)
    , CheckSpec(csFilename, csScript, csCheckSourced, csIncludedWarnings, csExcludedWarnings, csShellTypeOverride, csMinSeverity, csIgnoreRC, csOptionalChecks)
    , CheckResult(crFilename, crComments)
    , ParseSpec(psFilename, psScript, psCheckSourced, psIgnoreRC, psShellTypeOverride)
    , ParseResult(prComments, prTokenPositions, prRoot)
    , AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks)
    , AnalysisResult(arComments)
    , FormatterOptions(foColorOption, foWikiLinkCount)
    , Shell(Ksh, Sh, Bash, Dash)
    , ExecutionMode(Executed, Sourced)
    , ErrorMessage
    , Code
    , Severity(ErrorC, WarningC, InfoC, StyleC)
    , Position(posFile, posLine, posColumn)
    , Comment(cSeverity, cCode, cMessage)
    , PositionedComment(pcStartPos , pcEndPos , pcComment, pcFix)
    , ColorOption(ColorAuto, ColorAlways, ColorNever)
    , TokenComment(tcId, tcComment, tcFix)
    , emptyCheckResult
    , newParseResult
    , newAnalysisSpec
    , newAnalysisResult
    , newFormatterOptions
    , newPosition
    , newTokenComment
    , mockedSystemInterface
    , mockRcFile
    , newParseSpec
    , emptyCheckSpec
    , newPositionedComment
    , newComment
    , Fix(fixReplacements)
    , newFix
    , InsertionPoint(InsertBefore, InsertAfter)
    , Replacement(repStartPos, repEndPos, repString, repPrecedence, repInsertionPoint)
    , newReplacement
    , CheckDescription(cdName, cdDescription, cdPositive, cdNegative)
    , newCheckDescription
    ) where

import ShellCheck.AST

import Control.DeepSeq
import Control.Monad.Identity
import Data.List
import Data.Monoid
import Data.Ord
import Data.Semigroup
import GHC.Generics (Generic)
import qualified Data.Map as Map


data SystemInterface m = SystemInterface {
    -- | Given:
    --   What annotations say about including external files (if anything)
    --   A resolved filename from siFindSource
    --   Read the file or return an error
    SystemInterface m
-> Maybe Bool -> String -> m (Either String String)
siReadFile :: Maybe Bool -> String -> m (Either ErrorMessage String),
    -- | Given:
    --   the current script,
    --   what annotations say about including external files (if anything)
    --   a list of source-path annotations in effect,
    --   and a sourced file,
    --   find the sourced file
    SystemInterface m
-> String -> Maybe Bool -> [String] -> String -> m String
siFindSource :: String -> Maybe Bool -> [String] -> String -> m FilePath,
    -- | Get the configuration file (name, contents) for a filename
    SystemInterface m -> String -> m (Maybe (String, String))
siGetConfig :: String -> m (Maybe (FilePath, String))
}

-- ShellCheck input and output
data CheckSpec = CheckSpec {
    CheckSpec -> String
csFilename :: String,
    CheckSpec -> String
csScript :: String,
    CheckSpec -> Bool
csCheckSourced :: Bool,
    CheckSpec -> Bool
csIgnoreRC :: Bool,
    CheckSpec -> [Integer]
csExcludedWarnings :: [Integer],
    CheckSpec -> Maybe [Integer]
csIncludedWarnings :: Maybe [Integer],
    CheckSpec -> Maybe Shell
csShellTypeOverride :: Maybe Shell,
    CheckSpec -> Severity
csMinSeverity :: Severity,
    CheckSpec -> [String]
csOptionalChecks :: [String]
} deriving (Int -> CheckSpec -> ShowS
[CheckSpec] -> ShowS
CheckSpec -> String
(Int -> CheckSpec -> ShowS)
-> (CheckSpec -> String)
-> ([CheckSpec] -> ShowS)
-> Show CheckSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckSpec] -> ShowS
$cshowList :: [CheckSpec] -> ShowS
show :: CheckSpec -> String
$cshow :: CheckSpec -> String
showsPrec :: Int -> CheckSpec -> ShowS
$cshowsPrec :: Int -> CheckSpec -> ShowS
Show, CheckSpec -> CheckSpec -> Bool
(CheckSpec -> CheckSpec -> Bool)
-> (CheckSpec -> CheckSpec -> Bool) -> Eq CheckSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckSpec -> CheckSpec -> Bool
$c/= :: CheckSpec -> CheckSpec -> Bool
== :: CheckSpec -> CheckSpec -> Bool
$c== :: CheckSpec -> CheckSpec -> Bool
Eq)

data CheckResult = CheckResult {
    CheckResult -> String
crFilename :: String,
    CheckResult -> [PositionedComment]
crComments :: [PositionedComment]
} deriving (Int -> CheckResult -> ShowS
[CheckResult] -> ShowS
CheckResult -> String
(Int -> CheckResult -> ShowS)
-> (CheckResult -> String)
-> ([CheckResult] -> ShowS)
-> Show CheckResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckResult] -> ShowS
$cshowList :: [CheckResult] -> ShowS
show :: CheckResult -> String
$cshow :: CheckResult -> String
showsPrec :: Int -> CheckResult -> ShowS
$cshowsPrec :: Int -> CheckResult -> ShowS
Show, CheckResult -> CheckResult -> Bool
(CheckResult -> CheckResult -> Bool)
-> (CheckResult -> CheckResult -> Bool) -> Eq CheckResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckResult -> CheckResult -> Bool
$c/= :: CheckResult -> CheckResult -> Bool
== :: CheckResult -> CheckResult -> Bool
$c== :: CheckResult -> CheckResult -> Bool
Eq)

emptyCheckResult :: CheckResult
emptyCheckResult :: CheckResult
emptyCheckResult = CheckResult :: String -> [PositionedComment] -> CheckResult
CheckResult {
    crFilename :: String
crFilename = String
"",
    crComments :: [PositionedComment]
crComments = []
}

emptyCheckSpec :: CheckSpec
emptyCheckSpec :: CheckSpec
emptyCheckSpec = CheckSpec :: String
-> String
-> Bool
-> Bool
-> [Integer]
-> Maybe [Integer]
-> Maybe Shell
-> Severity
-> [String]
-> CheckSpec
CheckSpec {
    csFilename :: String
csFilename = String
"",
    csScript :: String
csScript = String
"",
    csCheckSourced :: Bool
csCheckSourced = Bool
False,
    csIgnoreRC :: Bool
csIgnoreRC = Bool
False,
    csExcludedWarnings :: [Integer]
csExcludedWarnings = [],
    csIncludedWarnings :: Maybe [Integer]
csIncludedWarnings = Maybe [Integer]
forall a. Maybe a
Nothing,
    csShellTypeOverride :: Maybe Shell
csShellTypeOverride = Maybe Shell
forall a. Maybe a
Nothing,
    csMinSeverity :: Severity
csMinSeverity = Severity
StyleC,
    csOptionalChecks :: [String]
csOptionalChecks = []
}

newParseSpec :: ParseSpec
newParseSpec :: ParseSpec
newParseSpec = ParseSpec :: String -> String -> Bool -> Bool -> Maybe Shell -> ParseSpec
ParseSpec {
    psFilename :: String
psFilename = String
"",
    psScript :: String
psScript = String
"",
    psCheckSourced :: Bool
psCheckSourced = Bool
False,
    psIgnoreRC :: Bool
psIgnoreRC = Bool
False,
    psShellTypeOverride :: Maybe Shell
psShellTypeOverride = Maybe Shell
forall a. Maybe a
Nothing
}

-- Parser input and output
data ParseSpec = ParseSpec {
    ParseSpec -> String
psFilename :: String,
    ParseSpec -> String
psScript :: String,
    ParseSpec -> Bool
psCheckSourced :: Bool,
    ParseSpec -> Bool
psIgnoreRC :: Bool,
    ParseSpec -> Maybe Shell
psShellTypeOverride :: Maybe Shell
} deriving (Int -> ParseSpec -> ShowS
[ParseSpec] -> ShowS
ParseSpec -> String
(Int -> ParseSpec -> ShowS)
-> (ParseSpec -> String)
-> ([ParseSpec] -> ShowS)
-> Show ParseSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseSpec] -> ShowS
$cshowList :: [ParseSpec] -> ShowS
show :: ParseSpec -> String
$cshow :: ParseSpec -> String
showsPrec :: Int -> ParseSpec -> ShowS
$cshowsPrec :: Int -> ParseSpec -> ShowS
Show, ParseSpec -> ParseSpec -> Bool
(ParseSpec -> ParseSpec -> Bool)
-> (ParseSpec -> ParseSpec -> Bool) -> Eq ParseSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseSpec -> ParseSpec -> Bool
$c/= :: ParseSpec -> ParseSpec -> Bool
== :: ParseSpec -> ParseSpec -> Bool
$c== :: ParseSpec -> ParseSpec -> Bool
Eq)

data ParseResult = ParseResult {
    ParseResult -> [PositionedComment]
prComments :: [PositionedComment],
    ParseResult -> Map Id (Position, Position)
prTokenPositions :: Map.Map Id (Position, Position),
    ParseResult -> Maybe Token
prRoot :: Maybe Token
} deriving (Int -> ParseResult -> ShowS
[ParseResult] -> ShowS
ParseResult -> String
(Int -> ParseResult -> ShowS)
-> (ParseResult -> String)
-> ([ParseResult] -> ShowS)
-> Show ParseResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseResult] -> ShowS
$cshowList :: [ParseResult] -> ShowS
show :: ParseResult -> String
$cshow :: ParseResult -> String
showsPrec :: Int -> ParseResult -> ShowS
$cshowsPrec :: Int -> ParseResult -> ShowS
Show, ParseResult -> ParseResult -> Bool
(ParseResult -> ParseResult -> Bool)
-> (ParseResult -> ParseResult -> Bool) -> Eq ParseResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseResult -> ParseResult -> Bool
$c/= :: ParseResult -> ParseResult -> Bool
== :: ParseResult -> ParseResult -> Bool
$c== :: ParseResult -> ParseResult -> Bool
Eq)

newParseResult :: ParseResult
newParseResult :: ParseResult
newParseResult = ParseResult :: [PositionedComment]
-> Map Id (Position, Position) -> Maybe Token -> ParseResult
ParseResult {
    prComments :: [PositionedComment]
prComments = [],
    prTokenPositions :: Map Id (Position, Position)
prTokenPositions = Map Id (Position, Position)
forall k a. Map k a
Map.empty,
    prRoot :: Maybe Token
prRoot = Maybe Token
forall a. Maybe a
Nothing
}

-- Analyzer input and output
data AnalysisSpec = AnalysisSpec {
    AnalysisSpec -> Token
asScript :: Token,
    AnalysisSpec -> Maybe Shell
asShellType :: Maybe Shell,
    AnalysisSpec -> Maybe Shell
asFallbackShell :: Maybe Shell,
    AnalysisSpec -> ExecutionMode
asExecutionMode :: ExecutionMode,
    AnalysisSpec -> Bool
asCheckSourced :: Bool,
    AnalysisSpec -> [String]
asOptionalChecks :: [String],
    AnalysisSpec -> Map Id (Position, Position)
asTokenPositions :: Map.Map Id (Position, Position)
}

newAnalysisSpec :: Token -> AnalysisSpec
newAnalysisSpec Token
token = AnalysisSpec :: Token
-> Maybe Shell
-> Maybe Shell
-> ExecutionMode
-> Bool
-> [String]
-> Map Id (Position, Position)
-> AnalysisSpec
AnalysisSpec {
    asScript :: Token
asScript = Token
token,
    asShellType :: Maybe Shell
asShellType = Maybe Shell
forall a. Maybe a
Nothing,
    asFallbackShell :: Maybe Shell
asFallbackShell = Maybe Shell
forall a. Maybe a
Nothing,
    asExecutionMode :: ExecutionMode
asExecutionMode = ExecutionMode
Executed,
    asCheckSourced :: Bool
asCheckSourced = Bool
False,
    asOptionalChecks :: [String]
asOptionalChecks = [],
    asTokenPositions :: Map Id (Position, Position)
asTokenPositions = Map Id (Position, Position)
forall k a. Map k a
Map.empty
}

newtype AnalysisResult = AnalysisResult {
    AnalysisResult -> [TokenComment]
arComments :: [TokenComment]
}

newAnalysisResult :: AnalysisResult
newAnalysisResult = AnalysisResult :: [TokenComment] -> AnalysisResult
AnalysisResult {
    arComments :: [TokenComment]
arComments = []
}

-- Formatter options
data FormatterOptions = FormatterOptions {
    FormatterOptions -> ColorOption
foColorOption :: ColorOption,
    FormatterOptions -> Integer
foWikiLinkCount :: Integer
}

newFormatterOptions :: FormatterOptions
newFormatterOptions = FormatterOptions :: ColorOption -> Integer -> FormatterOptions
FormatterOptions {
    foColorOption :: ColorOption
foColorOption = ColorOption
ColorAuto,
    foWikiLinkCount :: Integer
foWikiLinkCount = Integer
3
}

data CheckDescription = CheckDescription {
    CheckDescription -> String
cdName :: String,
    CheckDescription -> String
cdDescription :: String,
    CheckDescription -> String
cdPositive :: String,
    CheckDescription -> String
cdNegative :: String
    }

newCheckDescription :: CheckDescription
newCheckDescription = CheckDescription :: String -> String -> String -> String -> CheckDescription
CheckDescription {
    cdName :: String
cdName = String
"",
    cdDescription :: String
cdDescription = String
"",
    cdPositive :: String
cdPositive = String
"",
    cdNegative :: String
cdNegative = String
""
    }

-- Supporting data types
data Shell = Ksh | Sh | Bash | Dash deriving (Int -> Shell -> ShowS
[Shell] -> ShowS
Shell -> String
(Int -> Shell -> ShowS)
-> (Shell -> String) -> ([Shell] -> ShowS) -> Show Shell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shell] -> ShowS
$cshowList :: [Shell] -> ShowS
show :: Shell -> String
$cshow :: Shell -> String
showsPrec :: Int -> Shell -> ShowS
$cshowsPrec :: Int -> Shell -> ShowS
Show, Shell -> Shell -> Bool
(Shell -> Shell -> Bool) -> (Shell -> Shell -> Bool) -> Eq Shell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shell -> Shell -> Bool
$c/= :: Shell -> Shell -> Bool
== :: Shell -> Shell -> Bool
$c== :: Shell -> Shell -> Bool
Eq)
data ExecutionMode = Executed | Sourced deriving (Int -> ExecutionMode -> ShowS
[ExecutionMode] -> ShowS
ExecutionMode -> String
(Int -> ExecutionMode -> ShowS)
-> (ExecutionMode -> String)
-> ([ExecutionMode] -> ShowS)
-> Show ExecutionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutionMode] -> ShowS
$cshowList :: [ExecutionMode] -> ShowS
show :: ExecutionMode -> String
$cshow :: ExecutionMode -> String
showsPrec :: Int -> ExecutionMode -> ShowS
$cshowsPrec :: Int -> ExecutionMode -> ShowS
Show, ExecutionMode -> ExecutionMode -> Bool
(ExecutionMode -> ExecutionMode -> Bool)
-> (ExecutionMode -> ExecutionMode -> Bool) -> Eq ExecutionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutionMode -> ExecutionMode -> Bool
$c/= :: ExecutionMode -> ExecutionMode -> Bool
== :: ExecutionMode -> ExecutionMode -> Bool
$c== :: ExecutionMode -> ExecutionMode -> Bool
Eq)

type ErrorMessage = String
type Code = Integer

data Severity = ErrorC | WarningC | InfoC | StyleC
    deriving (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show, Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
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, Eq Severity
Eq Severity
-> (Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
$cp1Ord :: Eq Severity
Ord, (forall x. Severity -> Rep Severity x)
-> (forall x. Rep Severity x -> Severity) -> Generic Severity
forall x. Rep Severity x -> Severity
forall x. Severity -> Rep Severity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Severity x -> Severity
$cfrom :: forall x. Severity -> Rep Severity x
Generic, Severity -> ()
(Severity -> ()) -> NFData Severity
forall a. (a -> ()) -> NFData a
rnf :: Severity -> ()
$crnf :: Severity -> ()
NFData)
data Position = Position {
    Position -> String
posFile :: String,    -- Filename
    Position -> Integer
posLine :: Integer,   -- 1 based source line
    Position -> Integer
posColumn :: Integer  -- 1 based source column, where tabs are 8
} deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, (forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic, Position -> ()
(Position -> ()) -> NFData Position
forall a. (a -> ()) -> NFData a
rnf :: Position -> ()
$crnf :: Position -> ()
NFData, Eq Position
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord)

newPosition :: Position
newPosition :: Position
newPosition = Position :: String -> Integer -> Integer -> Position
Position {
    posFile :: String
posFile   = String
"",
    posLine :: Integer
posLine   = Integer
1,
    posColumn :: Integer
posColumn = Integer
1
}

data Comment = Comment {
    Comment -> Severity
cSeverity :: Severity,
    Comment -> Integer
cCode     :: Code,
    Comment -> String
cMessage  :: String
} deriving (Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show, Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq, (forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Comment x -> Comment
$cfrom :: forall x. Comment -> Rep Comment x
Generic, Comment -> ()
(Comment -> ()) -> NFData Comment
forall a. (a -> ()) -> NFData a
rnf :: Comment -> ()
$crnf :: Comment -> ()
NFData)

newComment :: Comment
newComment :: Comment
newComment = Comment :: Severity -> Integer -> String -> Comment
Comment {
    cSeverity :: Severity
cSeverity = Severity
StyleC,
    cCode :: Integer
cCode     = Integer
0,
    cMessage :: String
cMessage  = String
""
}

-- only support single line for now
data Replacement = Replacement {
    Replacement -> Position
repStartPos :: Position,
    Replacement -> Position
repEndPos :: Position,
    Replacement -> String
repString :: String,
    -- Order in which the replacements should happen: highest precedence first.
    Replacement -> Int
repPrecedence :: Int,
    -- Whether to insert immediately before or immediately after the specified region.
    Replacement -> InsertionPoint
repInsertionPoint :: InsertionPoint
} deriving (Int -> Replacement -> ShowS
[Replacement] -> ShowS
Replacement -> String
(Int -> Replacement -> ShowS)
-> (Replacement -> String)
-> ([Replacement] -> ShowS)
-> Show Replacement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Replacement] -> ShowS
$cshowList :: [Replacement] -> ShowS
show :: Replacement -> String
$cshow :: Replacement -> String
showsPrec :: Int -> Replacement -> ShowS
$cshowsPrec :: Int -> Replacement -> ShowS
Show, Replacement -> Replacement -> Bool
(Replacement -> Replacement -> Bool)
-> (Replacement -> Replacement -> Bool) -> Eq Replacement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Replacement -> Replacement -> Bool
$c/= :: Replacement -> Replacement -> Bool
== :: Replacement -> Replacement -> Bool
$c== :: Replacement -> Replacement -> Bool
Eq, (forall x. Replacement -> Rep Replacement x)
-> (forall x. Rep Replacement x -> Replacement)
-> Generic Replacement
forall x. Rep Replacement x -> Replacement
forall x. Replacement -> Rep Replacement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Replacement x -> Replacement
$cfrom :: forall x. Replacement -> Rep Replacement x
Generic, Replacement -> ()
(Replacement -> ()) -> NFData Replacement
forall a. (a -> ()) -> NFData a
rnf :: Replacement -> ()
$crnf :: Replacement -> ()
NFData)

data InsertionPoint = InsertBefore | InsertAfter
    deriving (Int -> InsertionPoint -> ShowS
[InsertionPoint] -> ShowS
InsertionPoint -> String
(Int -> InsertionPoint -> ShowS)
-> (InsertionPoint -> String)
-> ([InsertionPoint] -> ShowS)
-> Show InsertionPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsertionPoint] -> ShowS
$cshowList :: [InsertionPoint] -> ShowS
show :: InsertionPoint -> String
$cshow :: InsertionPoint -> String
showsPrec :: Int -> InsertionPoint -> ShowS
$cshowsPrec :: Int -> InsertionPoint -> ShowS
Show, InsertionPoint -> InsertionPoint -> Bool
(InsertionPoint -> InsertionPoint -> Bool)
-> (InsertionPoint -> InsertionPoint -> Bool) -> Eq InsertionPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertionPoint -> InsertionPoint -> Bool
$c/= :: InsertionPoint -> InsertionPoint -> Bool
== :: InsertionPoint -> InsertionPoint -> Bool
$c== :: InsertionPoint -> InsertionPoint -> Bool
Eq, (forall x. InsertionPoint -> Rep InsertionPoint x)
-> (forall x. Rep InsertionPoint x -> InsertionPoint)
-> Generic InsertionPoint
forall x. Rep InsertionPoint x -> InsertionPoint
forall x. InsertionPoint -> Rep InsertionPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InsertionPoint x -> InsertionPoint
$cfrom :: forall x. InsertionPoint -> Rep InsertionPoint x
Generic, InsertionPoint -> ()
(InsertionPoint -> ()) -> NFData InsertionPoint
forall a. (a -> ()) -> NFData a
rnf :: InsertionPoint -> ()
$crnf :: InsertionPoint -> ()
NFData)

newReplacement :: Replacement
newReplacement = Replacement :: Position
-> Position -> String -> Int -> InsertionPoint -> Replacement
Replacement {
    repStartPos :: Position
repStartPos = Position
newPosition,
    repEndPos :: Position
repEndPos = Position
newPosition,
    repString :: String
repString = String
"",
    repPrecedence :: Int
repPrecedence = Int
1,
    repInsertionPoint :: InsertionPoint
repInsertionPoint = InsertionPoint
InsertAfter
}

data Fix = Fix {
    Fix -> [Replacement]
fixReplacements :: [Replacement]
} deriving (Int -> Fix -> ShowS
[Fix] -> ShowS
Fix -> String
(Int -> Fix -> ShowS)
-> (Fix -> String) -> ([Fix] -> ShowS) -> Show Fix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fix] -> ShowS
$cshowList :: [Fix] -> ShowS
show :: Fix -> String
$cshow :: Fix -> String
showsPrec :: Int -> Fix -> ShowS
$cshowsPrec :: Int -> Fix -> ShowS
Show, Fix -> Fix -> Bool
(Fix -> Fix -> Bool) -> (Fix -> Fix -> Bool) -> Eq Fix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fix -> Fix -> Bool
$c/= :: Fix -> Fix -> Bool
== :: Fix -> Fix -> Bool
$c== :: Fix -> Fix -> Bool
Eq, (forall x. Fix -> Rep Fix x)
-> (forall x. Rep Fix x -> Fix) -> Generic Fix
forall x. Rep Fix x -> Fix
forall x. Fix -> Rep Fix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fix x -> Fix
$cfrom :: forall x. Fix -> Rep Fix x
Generic, Fix -> ()
(Fix -> ()) -> NFData Fix
forall a. (a -> ()) -> NFData a
rnf :: Fix -> ()
$crnf :: Fix -> ()
NFData)

newFix :: Fix
newFix = Fix :: [Replacement] -> Fix
Fix {
    fixReplacements :: [Replacement]
fixReplacements = []
}

data PositionedComment = PositionedComment {
    PositionedComment -> Position
pcStartPos :: Position,
    PositionedComment -> Position
pcEndPos   :: Position,
    PositionedComment -> Comment
pcComment  :: Comment,
    PositionedComment -> Maybe Fix
pcFix      :: Maybe Fix
} deriving (Int -> PositionedComment -> ShowS
[PositionedComment] -> ShowS
PositionedComment -> String
(Int -> PositionedComment -> ShowS)
-> (PositionedComment -> String)
-> ([PositionedComment] -> ShowS)
-> Show PositionedComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionedComment] -> ShowS
$cshowList :: [PositionedComment] -> ShowS
show :: PositionedComment -> String
$cshow :: PositionedComment -> String
showsPrec :: Int -> PositionedComment -> ShowS
$cshowsPrec :: Int -> PositionedComment -> ShowS
Show, PositionedComment -> PositionedComment -> Bool
(PositionedComment -> PositionedComment -> Bool)
-> (PositionedComment -> PositionedComment -> Bool)
-> Eq PositionedComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionedComment -> PositionedComment -> Bool
$c/= :: PositionedComment -> PositionedComment -> Bool
== :: PositionedComment -> PositionedComment -> Bool
$c== :: PositionedComment -> PositionedComment -> Bool
Eq, (forall x. PositionedComment -> Rep PositionedComment x)
-> (forall x. Rep PositionedComment x -> PositionedComment)
-> Generic PositionedComment
forall x. Rep PositionedComment x -> PositionedComment
forall x. PositionedComment -> Rep PositionedComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PositionedComment x -> PositionedComment
$cfrom :: forall x. PositionedComment -> Rep PositionedComment x
Generic, PositionedComment -> ()
(PositionedComment -> ()) -> NFData PositionedComment
forall a. (a -> ()) -> NFData a
rnf :: PositionedComment -> ()
$crnf :: PositionedComment -> ()
NFData)

newPositionedComment :: PositionedComment
newPositionedComment :: PositionedComment
newPositionedComment = PositionedComment :: Position -> Position -> Comment -> Maybe Fix -> PositionedComment
PositionedComment {
    pcStartPos :: Position
pcStartPos = Position
newPosition,
    pcEndPos :: Position
pcEndPos   = Position
newPosition,
    pcComment :: Comment
pcComment  = Comment
newComment,
    pcFix :: Maybe Fix
pcFix      = Maybe Fix
forall a. Maybe a
Nothing
}

data TokenComment = TokenComment {
    TokenComment -> Id
tcId :: Id,
    TokenComment -> Comment
tcComment :: Comment,
    TokenComment -> Maybe Fix
tcFix :: Maybe Fix
} deriving (Int -> TokenComment -> ShowS
[TokenComment] -> ShowS
TokenComment -> String
(Int -> TokenComment -> ShowS)
-> (TokenComment -> String)
-> ([TokenComment] -> ShowS)
-> Show TokenComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenComment] -> ShowS
$cshowList :: [TokenComment] -> ShowS
show :: TokenComment -> String
$cshow :: TokenComment -> String
showsPrec :: Int -> TokenComment -> ShowS
$cshowsPrec :: Int -> TokenComment -> ShowS
Show, TokenComment -> TokenComment -> Bool
(TokenComment -> TokenComment -> Bool)
-> (TokenComment -> TokenComment -> Bool) -> Eq TokenComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenComment -> TokenComment -> Bool
$c/= :: TokenComment -> TokenComment -> Bool
== :: TokenComment -> TokenComment -> Bool
$c== :: TokenComment -> TokenComment -> Bool
Eq, (forall x. TokenComment -> Rep TokenComment x)
-> (forall x. Rep TokenComment x -> TokenComment)
-> Generic TokenComment
forall x. Rep TokenComment x -> TokenComment
forall x. TokenComment -> Rep TokenComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenComment x -> TokenComment
$cfrom :: forall x. TokenComment -> Rep TokenComment x
Generic, TokenComment -> ()
(TokenComment -> ()) -> NFData TokenComment
forall a. (a -> ()) -> NFData a
rnf :: TokenComment -> ()
$crnf :: TokenComment -> ()
NFData)

newTokenComment :: TokenComment
newTokenComment = TokenComment :: Id -> Comment -> Maybe Fix -> TokenComment
TokenComment {
    tcId :: Id
tcId = Int -> Id
Id Int
0,
    tcComment :: Comment
tcComment = Comment
newComment,
    tcFix :: Maybe Fix
tcFix = Maybe Fix
forall a. Maybe a
Nothing
}

data ColorOption =
    ColorAuto
    | ColorAlways
    | ColorNever
  deriving (Eq ColorOption
Eq ColorOption
-> (ColorOption -> ColorOption -> Ordering)
-> (ColorOption -> ColorOption -> Bool)
-> (ColorOption -> ColorOption -> Bool)
-> (ColorOption -> ColorOption -> Bool)
-> (ColorOption -> ColorOption -> Bool)
-> (ColorOption -> ColorOption -> ColorOption)
-> (ColorOption -> ColorOption -> ColorOption)
-> Ord ColorOption
ColorOption -> ColorOption -> Bool
ColorOption -> ColorOption -> Ordering
ColorOption -> ColorOption -> ColorOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColorOption -> ColorOption -> ColorOption
$cmin :: ColorOption -> ColorOption -> ColorOption
max :: ColorOption -> ColorOption -> ColorOption
$cmax :: ColorOption -> ColorOption -> ColorOption
>= :: ColorOption -> ColorOption -> Bool
$c>= :: ColorOption -> ColorOption -> Bool
> :: ColorOption -> ColorOption -> Bool
$c> :: ColorOption -> ColorOption -> Bool
<= :: ColorOption -> ColorOption -> Bool
$c<= :: ColorOption -> ColorOption -> Bool
< :: ColorOption -> ColorOption -> Bool
$c< :: ColorOption -> ColorOption -> Bool
compare :: ColorOption -> ColorOption -> Ordering
$ccompare :: ColorOption -> ColorOption -> Ordering
$cp1Ord :: Eq ColorOption
Ord, ColorOption -> ColorOption -> Bool
(ColorOption -> ColorOption -> Bool)
-> (ColorOption -> ColorOption -> Bool) -> Eq ColorOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorOption -> ColorOption -> Bool
$c/= :: ColorOption -> ColorOption -> Bool
== :: ColorOption -> ColorOption -> Bool
$c== :: ColorOption -> ColorOption -> Bool
Eq, Int -> ColorOption -> ShowS
[ColorOption] -> ShowS
ColorOption -> String
(Int -> ColorOption -> ShowS)
-> (ColorOption -> String)
-> ([ColorOption] -> ShowS)
-> Show ColorOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorOption] -> ShowS
$cshowList :: [ColorOption] -> ShowS
show :: ColorOption -> String
$cshow :: ColorOption -> String
showsPrec :: Int -> ColorOption -> ShowS
$cshowsPrec :: Int -> ColorOption -> ShowS
Show)

-- For testing
mockedSystemInterface :: [(String, String)] -> SystemInterface Identity
mockedSystemInterface :: [(String, String)] -> SystemInterface Identity
mockedSystemInterface [(String, String)]
files = SystemInterface :: forall (m :: * -> *).
(Maybe Bool -> String -> m (Either String String))
-> (String -> Maybe Bool -> [String] -> String -> m String)
-> (String -> m (Maybe (String, String)))
-> SystemInterface m
SystemInterface {
    siReadFile :: Maybe Bool -> String -> Identity (Either String String)
siReadFile = Maybe Bool -> String -> Identity (Either String String)
forall (m :: * -> *) p.
Monad m =>
p -> String -> m (Either String String)
rf,
    siFindSource :: String -> Maybe Bool -> [String] -> String -> Identity String
siFindSource = String -> Maybe Bool -> [String] -> String -> Identity String
forall (m :: * -> *) p p p a. Monad m => p -> p -> p -> a -> m a
fs,
    siGetConfig :: String -> Identity (Maybe (String, String))
siGetConfig = Identity (Maybe (String, String))
-> String -> Identity (Maybe (String, String))
forall a b. a -> b -> a
const (Identity (Maybe (String, String))
 -> String -> Identity (Maybe (String, String)))
-> Identity (Maybe (String, String))
-> String
-> Identity (Maybe (String, String))
forall a b. (a -> b) -> a -> b
$ Maybe (String, String) -> Identity (Maybe (String, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, String)
forall a. Maybe a
Nothing
}
  where
    rf :: p -> String -> m (Either String String)
rf p
_ String
file = Either String String -> m (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> m (Either String String))
-> Either String String -> m (Either String String)
forall a b. (a -> b) -> a -> b
$
        case ((String, String) -> Bool)
-> [(String, String)] -> Maybe (String, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
file) (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
files of
            Maybe (String, String)
Nothing -> String -> Either String String
forall a b. a -> Either a b
Left String
"File not included in mock."
            Just (String
_, String
contents) -> String -> Either String String
forall a b. b -> Either a b
Right String
contents
    fs :: p -> p -> p -> a -> m a
fs p
_ p
_ p
_ a
file = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
file

mockRcFile :: String -> SystemInterface m -> SystemInterface m
mockRcFile String
rcfile SystemInterface m
mock = SystemInterface m
mock {
    siGetConfig :: String -> m (Maybe (String, String))
siGetConfig = m (Maybe (String, String)) -> String -> m (Maybe (String, String))
forall a b. a -> b -> a
const (m (Maybe (String, String))
 -> String -> m (Maybe (String, String)))
-> (Maybe (String, String) -> m (Maybe (String, String)))
-> Maybe (String, String)
-> String
-> m (Maybe (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (String, String) -> m (Maybe (String, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, String) -> String -> m (Maybe (String, String)))
-> Maybe (String, String) -> String -> m (Maybe (String, String))
forall a b. (a -> b) -> a -> b
$ (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
".shellcheckrc", String
rcfile)
}