1{-
2    Copyright 2012-2019 Vidar Holen
3
4    This file is part of ShellCheck.
5    https://www.shellcheck.net
6
7    ShellCheck is free software: you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation, either version 3 of the License, or
10    (at your option) any later version.
11
12    ShellCheck is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <https://www.gnu.org/licenses/>.
19-}
20{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
21module ShellCheck.Interface
22    (
23    SystemInterface(..)
24    , CheckSpec(csFilename, csScript, csCheckSourced, csIncludedWarnings, csExcludedWarnings, csShellTypeOverride, csMinSeverity, csIgnoreRC, csOptionalChecks)
25    , CheckResult(crFilename, crComments)
26    , ParseSpec(psFilename, psScript, psCheckSourced, psIgnoreRC, psShellTypeOverride)
27    , ParseResult(prComments, prTokenPositions, prRoot)
28    , AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks)
29    , AnalysisResult(arComments)
30    , FormatterOptions(foColorOption, foWikiLinkCount)
31    , Shell(Ksh, Sh, Bash, Dash)
32    , ExecutionMode(Executed, Sourced)
33    , ErrorMessage
34    , Code
35    , Severity(ErrorC, WarningC, InfoC, StyleC)
36    , Position(posFile, posLine, posColumn)
37    , Comment(cSeverity, cCode, cMessage)
38    , PositionedComment(pcStartPos , pcEndPos , pcComment, pcFix)
39    , ColorOption(ColorAuto, ColorAlways, ColorNever)
40    , TokenComment(tcId, tcComment, tcFix)
41    , emptyCheckResult
42    , newParseResult
43    , newAnalysisSpec
44    , newAnalysisResult
45    , newFormatterOptions
46    , newPosition
47    , newTokenComment
48    , mockedSystemInterface
49    , mockRcFile
50    , newParseSpec
51    , emptyCheckSpec
52    , newPositionedComment
53    , newComment
54    , Fix(fixReplacements)
55    , newFix
56    , InsertionPoint(InsertBefore, InsertAfter)
57    , Replacement(repStartPos, repEndPos, repString, repPrecedence, repInsertionPoint)
58    , newReplacement
59    , CheckDescription(cdName, cdDescription, cdPositive, cdNegative)
60    , newCheckDescription
61    ) where
62
63import ShellCheck.AST
64
65import Control.DeepSeq
66import Control.Monad.Identity
67import Data.List
68import Data.Monoid
69import Data.Ord
70import Data.Semigroup
71import GHC.Generics (Generic)
72import qualified Data.Map as Map
73
74
75data SystemInterface m = SystemInterface {
76    -- | Given:
77    --   What annotations say about including external files (if anything)
78    --   A resolved filename from siFindSource
79    --   Read the file or return an error
80    siReadFile :: Maybe Bool -> String -> m (Either ErrorMessage String),
81    -- | Given:
82    --   the current script,
83    --   what annotations say about including external files (if anything)
84    --   a list of source-path annotations in effect,
85    --   and a sourced file,
86    --   find the sourced file
87    siFindSource :: String -> Maybe Bool -> [String] -> String -> m FilePath,
88    -- | Get the configuration file (name, contents) for a filename
89    siGetConfig :: String -> m (Maybe (FilePath, String))
90}
91
92-- ShellCheck input and output
93data CheckSpec = CheckSpec {
94    csFilename :: String,
95    csScript :: String,
96    csCheckSourced :: Bool,
97    csIgnoreRC :: Bool,
98    csExcludedWarnings :: [Integer],
99    csIncludedWarnings :: Maybe [Integer],
100    csShellTypeOverride :: Maybe Shell,
101    csMinSeverity :: Severity,
102    csOptionalChecks :: [String]
103} deriving (Show, Eq)
104
105data CheckResult = CheckResult {
106    crFilename :: String,
107    crComments :: [PositionedComment]
108} deriving (Show, Eq)
109
110emptyCheckResult :: CheckResult
111emptyCheckResult = CheckResult {
112    crFilename = "",
113    crComments = []
114}
115
116emptyCheckSpec :: CheckSpec
117emptyCheckSpec = CheckSpec {
118    csFilename = "",
119    csScript = "",
120    csCheckSourced = False,
121    csIgnoreRC = False,
122    csExcludedWarnings = [],
123    csIncludedWarnings = Nothing,
124    csShellTypeOverride = Nothing,
125    csMinSeverity = StyleC,
126    csOptionalChecks = []
127}
128
129newParseSpec :: ParseSpec
130newParseSpec = ParseSpec {
131    psFilename = "",
132    psScript = "",
133    psCheckSourced = False,
134    psIgnoreRC = False,
135    psShellTypeOverride = Nothing
136}
137
138-- Parser input and output
139data ParseSpec = ParseSpec {
140    psFilename :: String,
141    psScript :: String,
142    psCheckSourced :: Bool,
143    psIgnoreRC :: Bool,
144    psShellTypeOverride :: Maybe Shell
145} deriving (Show, Eq)
146
147data ParseResult = ParseResult {
148    prComments :: [PositionedComment],
149    prTokenPositions :: Map.Map Id (Position, Position),
150    prRoot :: Maybe Token
151} deriving (Show, Eq)
152
153newParseResult :: ParseResult
154newParseResult = ParseResult {
155    prComments = [],
156    prTokenPositions = Map.empty,
157    prRoot = Nothing
158}
159
160-- Analyzer input and output
161data AnalysisSpec = AnalysisSpec {
162    asScript :: Token,
163    asShellType :: Maybe Shell,
164    asFallbackShell :: Maybe Shell,
165    asExecutionMode :: ExecutionMode,
166    asCheckSourced :: Bool,
167    asOptionalChecks :: [String],
168    asTokenPositions :: Map.Map Id (Position, Position)
169}
170
171newAnalysisSpec token = AnalysisSpec {
172    asScript = token,
173    asShellType = Nothing,
174    asFallbackShell = Nothing,
175    asExecutionMode = Executed,
176    asCheckSourced = False,
177    asOptionalChecks = [],
178    asTokenPositions = Map.empty
179}
180
181newtype AnalysisResult = AnalysisResult {
182    arComments :: [TokenComment]
183}
184
185newAnalysisResult = AnalysisResult {
186    arComments = []
187}
188
189-- Formatter options
190data FormatterOptions = FormatterOptions {
191    foColorOption :: ColorOption,
192    foWikiLinkCount :: Integer
193}
194
195newFormatterOptions = FormatterOptions {
196    foColorOption = ColorAuto,
197    foWikiLinkCount = 3
198}
199
200data CheckDescription = CheckDescription {
201    cdName :: String,
202    cdDescription :: String,
203    cdPositive :: String,
204    cdNegative :: String
205    }
206
207newCheckDescription = CheckDescription {
208    cdName = "",
209    cdDescription = "",
210    cdPositive = "",
211    cdNegative = ""
212    }
213
214-- Supporting data types
215data Shell = Ksh | Sh | Bash | Dash deriving (Show, Eq)
216data ExecutionMode = Executed | Sourced deriving (Show, Eq)
217
218type ErrorMessage = String
219type Code = Integer
220
221data Severity = ErrorC | WarningC | InfoC | StyleC
222    deriving (Show, Eq, Ord, Generic, NFData)
223data Position = Position {
224    posFile :: String,    -- Filename
225    posLine :: Integer,   -- 1 based source line
226    posColumn :: Integer  -- 1 based source column, where tabs are 8
227} deriving (Show, Eq, Generic, NFData, Ord)
228
229newPosition :: Position
230newPosition = Position {
231    posFile   = "",
232    posLine   = 1,
233    posColumn = 1
234}
235
236data Comment = Comment {
237    cSeverity :: Severity,
238    cCode     :: Code,
239    cMessage  :: String
240} deriving (Show, Eq, Generic, NFData)
241
242newComment :: Comment
243newComment = Comment {
244    cSeverity = StyleC,
245    cCode     = 0,
246    cMessage  = ""
247}
248
249-- only support single line for now
250data Replacement = Replacement {
251    repStartPos :: Position,
252    repEndPos :: Position,
253    repString :: String,
254    -- Order in which the replacements should happen: highest precedence first.
255    repPrecedence :: Int,
256    -- Whether to insert immediately before or immediately after the specified region.
257    repInsertionPoint :: InsertionPoint
258} deriving (Show, Eq, Generic, NFData)
259
260data InsertionPoint = InsertBefore | InsertAfter
261    deriving (Show, Eq, Generic, NFData)
262
263newReplacement = Replacement {
264    repStartPos = newPosition,
265    repEndPos = newPosition,
266    repString = "",
267    repPrecedence = 1,
268    repInsertionPoint = InsertAfter
269}
270
271data Fix = Fix {
272    fixReplacements :: [Replacement]
273} deriving (Show, Eq, Generic, NFData)
274
275newFix = Fix {
276    fixReplacements = []
277}
278
279data PositionedComment = PositionedComment {
280    pcStartPos :: Position,
281    pcEndPos   :: Position,
282    pcComment  :: Comment,
283    pcFix      :: Maybe Fix
284} deriving (Show, Eq, Generic, NFData)
285
286newPositionedComment :: PositionedComment
287newPositionedComment = PositionedComment {
288    pcStartPos = newPosition,
289    pcEndPos   = newPosition,
290    pcComment  = newComment,
291    pcFix      = Nothing
292}
293
294data TokenComment = TokenComment {
295    tcId :: Id,
296    tcComment :: Comment,
297    tcFix :: Maybe Fix
298} deriving (Show, Eq, Generic, NFData)
299
300newTokenComment = TokenComment {
301    tcId = Id 0,
302    tcComment = newComment,
303    tcFix = Nothing
304}
305
306data ColorOption =
307    ColorAuto
308    | ColorAlways
309    | ColorNever
310  deriving (Ord, Eq, Show)
311
312-- For testing
313mockedSystemInterface :: [(String, String)] -> SystemInterface Identity
314mockedSystemInterface files = SystemInterface {
315    siReadFile = rf,
316    siFindSource = fs,
317    siGetConfig = const $ return Nothing
318}
319  where
320    rf _ file = return $
321        case find ((== file) . fst) files of
322            Nothing -> Left "File not included in mock."
323            Just (_, contents) -> Right contents
324    fs _ _ _ file = return file
325
326mockRcFile rcfile mock = mock {
327    siGetConfig = const . return $ Just (".shellcheckrc", rcfile)
328}
329
330