Some cleanup to make room for future improvements.
This commit is contained in:
Vidar Holen
parent
6d9e8472e6
commit
72eeafe002
|
|
@ -41,18 +41,19 @@ library
|
|||
containers,
|
||||
directory,
|
||||
json,
|
||||
mtl,
|
||||
mtl >= 2.2.1,
|
||||
parsec,
|
||||
regex-tdfa,
|
||||
QuickCheck >= 2.7.4
|
||||
exposed-modules:
|
||||
ShellCheck.Checker
|
||||
ShellCheck.Analyzer
|
||||
ShellCheck.Parser
|
||||
ShellCheck.Analytics
|
||||
ShellCheck.AST
|
||||
ShellCheck.Data
|
||||
ShellCheck.Options
|
||||
ShellCheck.Parser
|
||||
ShellCheck.Interface
|
||||
ShellCheck.Regex
|
||||
ShellCheck.Simple
|
||||
other-modules:
|
||||
Paths_ShellCheck
|
||||
|
||||
|
|
@ -63,10 +64,9 @@ executable shellcheck
|
|||
containers,
|
||||
directory,
|
||||
json,
|
||||
mtl,
|
||||
mtl >= 2.2.1,
|
||||
parsec,
|
||||
regex-tdfa,
|
||||
transformers,
|
||||
QuickCheck >= 2.7.4
|
||||
main-is: shellcheck.hs
|
||||
|
||||
|
|
@ -78,10 +78,9 @@ test-suite test-shellcheck
|
|||
containers,
|
||||
directory,
|
||||
json,
|
||||
mtl,
|
||||
mtl >= 2.2.1,
|
||||
parsec,
|
||||
regex-tdfa,
|
||||
transformers,
|
||||
QuickCheck >= 2.7.4
|
||||
main-is: test/shellcheck.hs
|
||||
|
||||
|
|
|
|||
|
|
@ -18,10 +18,17 @@
|
|||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}
|
||||
module ShellCheck.Analytics (AnalysisOptions(..), defaultAnalysisOptions, filterByAnnotation, runAnalytics, shellForExecutable, runTests) where
|
||||
module ShellCheck.Analytics (runAnalytics, ShellCheck.Analytics.runTests) where
|
||||
|
||||
import ShellCheck.AST
|
||||
import ShellCheck.Data
|
||||
import ShellCheck.Parser
|
||||
import ShellCheck.Interface
|
||||
import ShellCheck.Regex
|
||||
|
||||
import Control.Arrow (first)
|
||||
import Control.Monad
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer
|
||||
import Data.Char
|
||||
|
|
@ -31,11 +38,6 @@ import Data.List
|
|||
import Data.Maybe
|
||||
import Data.Ord
|
||||
import Debug.Trace
|
||||
import ShellCheck.AST
|
||||
import ShellCheck.Options
|
||||
import ShellCheck.Data
|
||||
import ShellCheck.Parser hiding (runTests)
|
||||
import ShellCheck.Regex
|
||||
import qualified Data.Map as Map
|
||||
import Test.QuickCheck.All (forAllProperties)
|
||||
import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)
|
||||
|
|
@ -48,7 +50,7 @@ data Parameters = Parameters {
|
|||
}
|
||||
|
||||
-- Checks that are run on the AST root
|
||||
treeChecks :: [Parameters -> Token -> [Note]]
|
||||
treeChecks :: [Parameters -> Token -> [TokenComment]]
|
||||
treeChecks = [
|
||||
runNodeAnalysis
|
||||
(\p t -> (mapM_ ((\ f -> f t) . (\ f -> f p))
|
||||
|
|
@ -81,19 +83,28 @@ checksFor Bash = [
|
|||
,checkForDecimals
|
||||
]
|
||||
|
||||
runAnalytics :: AnalysisOptions -> Token -> [Note]
|
||||
runAnalytics options root = runList options root treeChecks
|
||||
|
||||
runList options root list = notes
|
||||
where
|
||||
params = Parameters {
|
||||
shellType = fromMaybe (determineShell root) $ optionShellType options,
|
||||
shellTypeSpecified = isJust $ optionShellType options,
|
||||
parentMap = getParentTree root,
|
||||
variableFlow = getVariableFlow (shellType params) (parentMap params) root
|
||||
runAnalytics :: AnalysisSpec -> AnalysisResult
|
||||
runAnalytics options = AnalysisResult {
|
||||
arComments =
|
||||
nub . filterByAnnotation (asScript options) $
|
||||
runList options treeChecks
|
||||
}
|
||||
notes = filter (\c -> getCode c `notElem` optionExcludes options) $ concatMap (\f -> f params root) list
|
||||
getCode (Note _ _ c _) = c
|
||||
|
||||
runList :: AnalysisSpec -> [Parameters -> Token -> [TokenComment]]
|
||||
-> [TokenComment]
|
||||
runList spec list = notes
|
||||
where
|
||||
root = asScript spec
|
||||
params = Parameters {
|
||||
shellType = fromMaybe (determineShell root) $ asShellType spec,
|
||||
shellTypeSpecified = isJust $ asShellType spec,
|
||||
parentMap = getParentTree root,
|
||||
variableFlow =
|
||||
getVariableFlow (shellType params) (parentMap params) root
|
||||
}
|
||||
notes = concatMap (\f -> f params root) list
|
||||
|
||||
getCode (TokenComment _ (Comment _ c _)) = c
|
||||
|
||||
|
||||
checkList l t = concatMap (\f -> f t) l
|
||||
|
|
@ -107,21 +118,10 @@ determineShell (T_Script _ shebang _) = fromMaybe Bash . shellForExecutable $ sh
|
|||
shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s
|
||||
shellFor s = reverse . takeWhile (/= '/') . reverse $ s
|
||||
|
||||
shellForExecutable "sh" = return Sh
|
||||
shellForExecutable "ash" = return Sh
|
||||
shellForExecutable "dash" = return Sh
|
||||
|
||||
shellForExecutable "ksh" = return Ksh
|
||||
shellForExecutable "ksh88" = return Ksh
|
||||
shellForExecutable "ksh93" = return Ksh
|
||||
|
||||
shellForExecutable "bash" = return Bash
|
||||
shellForExecutable _ = Nothing
|
||||
|
||||
-- Checks that are run on each node in the AST
|
||||
runNodeAnalysis f p t = execWriter (doAnalysis (f p) t)
|
||||
|
||||
nodeChecks :: [Parameters -> Token -> Writer [Note] ()]
|
||||
nodeChecks :: [Parameters -> Token -> Writer [TokenComment] ()]
|
||||
nodeChecks = [
|
||||
checkUuoc
|
||||
,checkPipePitfalls
|
||||
|
|
@ -216,10 +216,9 @@ nodeChecks = [
|
|||
filterByAnnotation token =
|
||||
filter (not . shouldIgnore)
|
||||
where
|
||||
numFor (Note _ _ code _) = code
|
||||
idFor (Note id _ _ _) = id
|
||||
idFor (TokenComment id _) = id
|
||||
shouldIgnore note =
|
||||
any (shouldIgnoreFor (numFor note)) $
|
||||
any (shouldIgnoreFor (getCode note)) $
|
||||
getPath parents (T_Bang $ idFor note)
|
||||
shouldIgnoreFor num (T_Annotation _ anns _) =
|
||||
any hasNum anns
|
||||
|
|
@ -228,12 +227,17 @@ filterByAnnotation token =
|
|||
shouldIgnoreFor _ _ = False
|
||||
parents = getParentTree token
|
||||
|
||||
addNote note = tell [note]
|
||||
makeNote severity id code note = addNote $ Note id severity code note
|
||||
warn = makeNote WarningC
|
||||
err = makeNote ErrorC
|
||||
info = makeNote InfoC
|
||||
style = makeNote StyleC
|
||||
makeComment :: Severity -> Id -> Code -> String -> TokenComment
|
||||
makeComment severity id code note =
|
||||
TokenComment id $ Comment severity code note
|
||||
|
||||
addComment note = tell [note]
|
||||
|
||||
warn :: MonadWriter [TokenComment] m => Id -> Code -> String -> m ()
|
||||
warn id code str = addComment $ makeComment WarningC id code str
|
||||
err id code str = addComment $ makeComment ErrorC id code str
|
||||
info id code str = addComment $ makeComment InfoC id code str
|
||||
style id code str = addComment $ makeComment StyleC id code str
|
||||
|
||||
isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
|
||||
isVariableChar x = isVariableStartChar x || isDigit x
|
||||
|
|
@ -343,23 +347,33 @@ getLeadingFlags = getFlagsUntil (not . ("-" `isPrefixOf`))
|
|||
[] -> Nothing
|
||||
(r:_) -> Just r
|
||||
|
||||
verify :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool
|
||||
verify :: (Parameters -> Token -> Writer [TokenComment] ()) -> String -> Bool
|
||||
verify f s = checkNode f s == Just True
|
||||
|
||||
verifyNot :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool
|
||||
verifyNot :: (Parameters -> Token -> Writer [TokenComment] ()) -> String -> Bool
|
||||
verifyNot f s = checkNode f s == Just False
|
||||
|
||||
verifyTree :: (Parameters -> Token -> [Note]) -> String -> Bool
|
||||
verifyTree f s = checkTree f s == Just True
|
||||
verifyTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool
|
||||
verifyTree f s = producesComments f s == Just True
|
||||
|
||||
verifyNotTree :: (Parameters -> Token -> [Note]) -> String -> Bool
|
||||
verifyNotTree f s = checkTree f s == Just False
|
||||
verifyNotTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool
|
||||
verifyNotTree f s = producesComments f s == Just False
|
||||
|
||||
checkNode f = checkTree (runNodeAnalysis f)
|
||||
checkTree f s = case parseShell defaultAnalysisOptions "-" s of
|
||||
(ParseResult (Just (t, m)) _) -> Just . not . null $ runList defaultAnalysisOptions t [f]
|
||||
_ -> Nothing
|
||||
|
||||
defaultSpec root = AnalysisSpec {
|
||||
asScript = root,
|
||||
asShellType = Nothing,
|
||||
asExecutionMode = Executed
|
||||
}
|
||||
|
||||
checkNode f = producesComments (runNodeAnalysis f)
|
||||
producesComments :: (Parameters -> Token -> [TokenComment]) -> String -> Maybe Bool
|
||||
producesComments f s = do
|
||||
root <- prRoot pResult
|
||||
return . not . null $ runList (defaultSpec root) [f]
|
||||
where
|
||||
pSpec = ParseSpec { psScript = s }
|
||||
pResult = runIdentity $ parseScript (mockedSystemInterface []) pSpec
|
||||
|
||||
-- Copied from https://wiki.haskell.org/Edit_distance
|
||||
dist :: Eq a => [a] -> [a] -> Int
|
||||
|
|
@ -628,13 +642,13 @@ mayBecomeMultipleArgs t = willBecomeMultipleArgs t || f t
|
|||
prop_checkShebangParameters1 = verifyTree checkShebangParameters "#!/usr/bin/env bash -x\necho cow"
|
||||
prop_checkShebangParameters2 = verifyNotTree checkShebangParameters "#! /bin/sh -l "
|
||||
checkShebangParameters _ (T_Script id sb _) =
|
||||
[Note id ErrorC 2096 "On most OS, shebangs can only specify a single parameter." | length (words sb) > 2]
|
||||
[makeComment ErrorC id 2096 "On most OS, shebangs can only specify a single parameter." | length (words sb) > 2]
|
||||
|
||||
prop_checkShebang1 = verifyNotTree checkShebang "#!/usr/bin/env bash -x\necho cow"
|
||||
prop_checkShebang2 = verifyNotTree checkShebang "#! /bin/sh -l "
|
||||
prop_checkShebang3 = verifyTree checkShebang "ls -l"
|
||||
checkShebang params (T_Script id sb _) =
|
||||
[Note id ErrorC 2148 "Tips depend on target shell and yours is unknown. Add a shebang."
|
||||
[makeComment ErrorC id 2148 "Tips depend on target shell and yours is unknown. Add a shebang."
|
||||
| not (shellTypeSpecified params) && sb == "" ]
|
||||
|
||||
prop_checkBashisms = verify checkBashisms "while read a; do :; done < <(a)"
|
||||
|
|
@ -901,15 +915,15 @@ prop_checkRedirectToSame5 = verifyNot checkRedirectToSame "foo > bar 2> bar"
|
|||
checkRedirectToSame params s@(T_Pipeline _ _ list) =
|
||||
mapM_ (\l -> (mapM_ (\x -> doAnalysis (checkOccurrences x) l) (getAllRedirs list))) list
|
||||
where
|
||||
note x = Note x InfoC 2094
|
||||
note x = makeComment InfoC x 2094
|
||||
"Make sure not to read and write the same file in the same pipeline."
|
||||
checkOccurrences t@(T_NormalWord exceptId x) u@(T_NormalWord newId y) =
|
||||
when (exceptId /= newId
|
||||
&& x == y
|
||||
&& not (isOutput t && isOutput u)
|
||||
&& not (special t)) $ do
|
||||
addNote $ note newId
|
||||
addNote $ note exceptId
|
||||
addComment $ note newId
|
||||
addComment $ note exceptId
|
||||
checkOccurrences _ _ = return ()
|
||||
getAllRedirs = concatMap (\t ->
|
||||
case t of
|
||||
|
|
@ -1028,7 +1042,7 @@ checkArrayWithoutIndex params _ =
|
|||
return . maybeToList $ do
|
||||
name <- getLiteralString token
|
||||
assignment <- Map.lookup name map
|
||||
return [Note id WarningC 2128
|
||||
return [makeComment WarningC id 2128
|
||||
"Expanding an array without an index only gives the first element."]
|
||||
readF _ _ _ = return []
|
||||
|
||||
|
|
@ -2495,6 +2509,17 @@ findSubshelled (StackScopeEnd:rest) ((reason, scope):oldScopes) deadVars =
|
|||
foldl (\m (_, token, var, _) ->
|
||||
Map.insert var (Dead token reason) m) deadVars scope
|
||||
|
||||
|
||||
-- FIXME: This is a very strange way of doing it.
|
||||
-- For each variable read/write, run a stateful function that emits
|
||||
-- comments. The comments are collected and returned.
|
||||
doVariableFlowAnalysis ::
|
||||
(Token -> Token -> String -> State t [v])
|
||||
-> (Token -> Token -> String -> DataType -> State t [v])
|
||||
-> t
|
||||
-> [StackData]
|
||||
-> [v]
|
||||
|
||||
doVariableFlowAnalysis readFunc writeFunc empty flow = evalState (
|
||||
foldM (\list x -> do { l <- doFlow x; return $ l ++ list; }) [] flow
|
||||
) empty
|
||||
|
|
@ -2548,7 +2573,7 @@ checkSpacefulness params t =
|
|||
|
||||
readF _ token name = do
|
||||
spaced <- hasSpaces name
|
||||
return [Note (getId token) InfoC 2086 warning |
|
||||
return [makeComment InfoC (getId token) 2086 warning |
|
||||
spaced
|
||||
&& not (isArrayExpansion token) -- There's another warning for this
|
||||
&& not (isCounting token)
|
||||
|
|
@ -2652,9 +2677,9 @@ checkQuotesInLiterals params t =
|
|||
&& not (isParamTo parents "eval" expr)
|
||||
&& not (isQuoteFree parents expr)
|
||||
then [
|
||||
Note (fromJust assignment)WarningC 2089
|
||||
makeComment WarningC (fromJust assignment) 2089
|
||||
"Quotes/backslashes will be treated literally. Use an array.",
|
||||
Note (getId expr) WarningC 2090
|
||||
makeComment WarningC (getId expr) 2090
|
||||
"Quotes/backslashes in this variable will not be respected."
|
||||
]
|
||||
else [])
|
||||
|
|
|
|||
|
|
@ -0,0 +1,27 @@
|
|||
{-
|
||||
Copyright 2012-2015 Vidar Holen
|
||||
|
||||
This file is part of ShellCheck.
|
||||
http://www.vidarholen.net/contents/shellcheck
|
||||
|
||||
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 <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
module ShellCheck.Analyzer (analyzeScript) where
|
||||
|
||||
import ShellCheck.Interface
|
||||
import ShellCheck.Analytics
|
||||
|
||||
-- TODO: Clean up the cruft this is layered on
|
||||
analyzeScript :: AnalysisSpec -> AnalysisResult
|
||||
analyzeScript = runAnalytics
|
||||
|
|
@ -0,0 +1,124 @@
|
|||
{-
|
||||
Copyright 2012-2015 Vidar Holen
|
||||
|
||||
This file is part of ShellCheck.
|
||||
http://www.vidarholen.net/contents/shellcheck
|
||||
|
||||
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 <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module ShellCheck.Checker (checkScript, ShellCheck.Checker.runTests) where
|
||||
|
||||
import ShellCheck.Interface
|
||||
import ShellCheck.Parser
|
||||
import ShellCheck.Analyzer
|
||||
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Ord
|
||||
import Control.Monad.Identity
|
||||
import qualified Data.Map as Map
|
||||
import qualified System.IO
|
||||
import Prelude hiding (readFile)
|
||||
import Control.Monad
|
||||
|
||||
import Test.QuickCheck.All
|
||||
|
||||
tokenToPosition map (TokenComment id c) = fromMaybe fail $ do
|
||||
position <- Map.lookup id map
|
||||
return $ PositionedComment position c
|
||||
where
|
||||
fail = error "Internal shellcheck error: id doesn't exist. Please report!"
|
||||
|
||||
checkScript :: Monad m => SystemInterface m -> CheckSpec -> m CheckResult
|
||||
checkScript sys spec = do
|
||||
results <- checkScript (csScript spec)
|
||||
return CheckResult {
|
||||
crComments = results
|
||||
}
|
||||
where
|
||||
checkScript contents = do
|
||||
result <- parseScript sys ParseSpec { psScript = contents }
|
||||
let parseMessages = prComments result
|
||||
let analysisMessages =
|
||||
fromMaybe [] $
|
||||
(arComments . analyzeScript . analysisSpec)
|
||||
<$> prRoot result
|
||||
let translator = tokenToPosition (prTokenPositions result)
|
||||
return . sortMessages . filter shouldInclude $
|
||||
(parseMessages ++ map translator analysisMessages)
|
||||
|
||||
shouldInclude (PositionedComment _ (Comment _ code _)) =
|
||||
code `notElem` csExcludedWarnings spec
|
||||
|
||||
sortMessages = sortBy (comparing order)
|
||||
order (PositionedComment pos (Comment severity code message)) =
|
||||
(posFile pos, posLine pos, posColumn pos, code, message)
|
||||
getPosition (PositionedComment pos _) = pos
|
||||
|
||||
analysisSpec root =
|
||||
AnalysisSpec {
|
||||
asScript = root,
|
||||
asShellType = csShellTypeOverride spec,
|
||||
asExecutionMode = Executed
|
||||
}
|
||||
|
||||
getErrors sys spec =
|
||||
map getCode . crComments $
|
||||
runIdentity (checkScript sys spec)
|
||||
where
|
||||
getCode (PositionedComment _ (Comment _ code _)) = code
|
||||
|
||||
check str =
|
||||
getErrors
|
||||
(mockedSystemInterface [])
|
||||
emptyCheckSpec {
|
||||
csScript = str,
|
||||
csExcludedWarnings = [2148]
|
||||
}
|
||||
|
||||
prop_findsParseIssue = check "echo \"$12\"" == [1037]
|
||||
|
||||
prop_commentDisablesParseIssue1 =
|
||||
null $ check "#shellcheck disable=SC1037\necho \"$12\""
|
||||
prop_commentDisablesParseIssue2 =
|
||||
null $ check "#shellcheck disable=SC1037\n#lol\necho \"$12\""
|
||||
|
||||
prop_findsAnalysisIssue =
|
||||
check "echo $1" == [2086]
|
||||
prop_commentDisablesAnalysisIssue1 =
|
||||
null $ check "#shellcheck disable=SC2086\necho $1"
|
||||
prop_commentDisablesAnalysisIssue2 =
|
||||
null $ check "#shellcheck disable=SC2086\n#lol\necho $1"
|
||||
|
||||
prop_optionDisablesIssue1 =
|
||||
null $ getErrors
|
||||
(mockedSystemInterface [])
|
||||
emptyCheckSpec {
|
||||
csScript = "echo $1",
|
||||
csExcludedWarnings = [2148, 2086]
|
||||
}
|
||||
|
||||
prop_optionDisablesIssue2 =
|
||||
null $ getErrors
|
||||
(mockedSystemInterface [])
|
||||
emptyCheckSpec {
|
||||
csScript = "echo \"$10\"",
|
||||
csExcludedWarnings = [2148, 1037]
|
||||
}
|
||||
|
||||
return []
|
||||
runTests = $quickCheckAll
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
module ShellCheck.Data where
|
||||
|
||||
import ShellCheck.Interface
|
||||
import Data.Version (showVersion)
|
||||
import Paths_ShellCheck (version)
|
||||
|
||||
|
|
@ -73,3 +74,15 @@ sampleWords = [
|
|||
"tango", "uniform", "victor", "whiskey", "xray", "yankee",
|
||||
"zulu"
|
||||
]
|
||||
|
||||
shellForExecutable :: String -> Maybe Shell
|
||||
shellForExecutable "sh" = return Sh
|
||||
shellForExecutable "ash" = return Sh
|
||||
shellForExecutable "dash" = return Sh
|
||||
|
||||
shellForExecutable "ksh" = return Ksh
|
||||
shellForExecutable "ksh88" = return Ksh
|
||||
shellForExecutable "ksh93" = return Ksh
|
||||
|
||||
shellForExecutable "bash" = return Bash
|
||||
shellForExecutable _ = Nothing
|
||||
|
|
|
|||
|
|
@ -0,0 +1,99 @@
|
|||
{-
|
||||
Copyright 2012-2015 Vidar Holen
|
||||
|
||||
This file is part of ShellCheck.
|
||||
http://www.vidarholen.net/contents/shellcheck
|
||||
|
||||
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 <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
module ShellCheck.Interface where
|
||||
|
||||
import ShellCheck.AST
|
||||
import Control.Monad.Identity
|
||||
import qualified Data.Map as Map
|
||||
|
||||
|
||||
data SystemInterface m = SystemInterface {
|
||||
-- Read a file by filename, or return an error
|
||||
siReadFile :: String -> m (Either ErrorMessage String)
|
||||
}
|
||||
|
||||
-- ShellCheck input and output
|
||||
data CheckSpec = CheckSpec {
|
||||
csScript :: String,
|
||||
csExcludedWarnings :: [Integer],
|
||||
csShellTypeOverride :: Maybe Shell
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data CheckResult = CheckResult {
|
||||
crComments :: [PositionedComment]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
emptyCheckSpec = CheckSpec {
|
||||
csScript = "",
|
||||
csExcludedWarnings = [],
|
||||
csShellTypeOverride = Nothing
|
||||
}
|
||||
|
||||
-- Parser input and output
|
||||
data ParseSpec = ParseSpec {
|
||||
psScript :: String
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data ParseResult = ParseResult {
|
||||
prComments :: [PositionedComment],
|
||||
prTokenPositions :: Map.Map Id Position,
|
||||
prRoot :: Maybe Token
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- Analyzer input and output
|
||||
data AnalysisSpec = AnalysisSpec {
|
||||
asScript :: Token,
|
||||
asShellType :: Maybe Shell,
|
||||
asExecutionMode :: ExecutionMode
|
||||
}
|
||||
|
||||
data AnalysisResult = AnalysisResult {
|
||||
arComments :: [TokenComment]
|
||||
}
|
||||
|
||||
-- Supporting data types
|
||||
data Shell = Ksh | Sh | Bash deriving (Show, Eq)
|
||||
data ExecutionMode = Executed | Sourced deriving (Show, Eq)
|
||||
|
||||
type ErrorMessage = String
|
||||
type Code = Integer
|
||||
|
||||
data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord)
|
||||
data Position = Position {
|
||||
posFile :: String, -- Filename
|
||||
posLine :: Integer, -- 1 based source line
|
||||
posColumn :: Integer -- 1 based source column, where tabs are 8
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data Comment = Comment Severity Code String deriving (Show, Eq)
|
||||
data PositionedComment = PositionedComment Position Comment deriving (Show, Eq)
|
||||
data TokenComment = TokenComment Id Comment deriving (Show, Eq)
|
||||
|
||||
-- For testing
|
||||
mockedSystemInterface :: [(String, String)] -> SystemInterface Identity
|
||||
mockedSystemInterface files = SystemInterface {
|
||||
siReadFile = rf
|
||||
}
|
||||
where
|
||||
rf file =
|
||||
case filter ((== file) . fst) files of
|
||||
[] -> return $ Left "File not included in mock."
|
||||
[(_, contents)] -> return $ Right contents
|
||||
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
module ShellCheck.Options where
|
||||
|
||||
data Shell = Ksh | Sh | Bash
|
||||
deriving (Show, Eq)
|
||||
|
||||
data AnalysisOptions = AnalysisOptions {
|
||||
optionShellType :: Maybe Shell,
|
||||
optionExcludes :: [Integer]
|
||||
}
|
||||
|
||||
defaultAnalysisOptions = AnalysisOptions {
|
||||
optionShellType = Nothing,
|
||||
optionExcludes = []
|
||||
}
|
||||
|
|
@ -18,19 +18,21 @@
|
|||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
{-# LANGUAGE NoMonomorphismRestriction, TemplateHaskell, FlexibleContexts #-}
|
||||
module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote, runTests, readScript) where
|
||||
module ShellCheck.Parser (parseScript, runTests) where
|
||||
|
||||
import ShellCheck.AST
|
||||
import ShellCheck.Data
|
||||
import ShellCheck.Options
|
||||
import Text.Parsec
|
||||
import ShellCheck.Interface
|
||||
import Text.Parsec hiding (runParser)
|
||||
import Debug.Trace
|
||||
import Control.Monad
|
||||
import Control.Arrow (first)
|
||||
import Control.Monad.Identity
|
||||
import Data.Char
|
||||
import Data.Functor
|
||||
import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Control.Monad.State as Ms
|
||||
import qualified Control.Monad.Reader as Mr
|
||||
import Data.Maybe
|
||||
import Prelude hiding (readList)
|
||||
import System.IO
|
||||
|
|
@ -38,6 +40,10 @@ import Text.Parsec.Error
|
|||
import GHC.Exts (sortWith)
|
||||
import Test.QuickCheck.All (quickCheckAll)
|
||||
|
||||
type SCBase m = Mr.ReaderT (SystemInterface m) (Ms.StateT SystemState m)
|
||||
type SCParser m v = ParsecT String UserState (SCBase m) v
|
||||
|
||||
backslash :: Monad m => SCParser m Char
|
||||
backslash = char '\\'
|
||||
linefeed = optional carriageReturn >> char '\n'
|
||||
singleQuote = char '\'' <|> unicodeSingleQuote
|
||||
|
|
@ -119,9 +125,18 @@ almostSpace =
|
|||
--------- Message/position annotation on top of user state
|
||||
data Note = Note Id Severity Code String deriving (Show, Eq)
|
||||
data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq)
|
||||
data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord)
|
||||
data Context = ContextName SourcePos String | ContextAnnotation [Annotation] deriving (Show)
|
||||
type Code = Integer
|
||||
|
||||
data UserState = UserState {
|
||||
lastId :: Id,
|
||||
positionMap :: Map.Map Id SourcePos,
|
||||
parseNotes :: [ParseNote]
|
||||
}
|
||||
initialUserState = UserState {
|
||||
lastId = Id $ -1,
|
||||
positionMap = Map.empty,
|
||||
parseNotes = []
|
||||
}
|
||||
|
||||
codeForParseNote (ParseNote _ _ code _) = code
|
||||
noteToParseNote map (Note id severity code message) =
|
||||
|
|
@ -129,17 +144,17 @@ noteToParseNote map (Note id severity code message) =
|
|||
where
|
||||
pos = fromJust $ Map.lookup id map
|
||||
|
||||
initialState = (Id $ -1, Map.empty, [])
|
||||
|
||||
getLastId = do
|
||||
(id, _, _) <- getState
|
||||
return id
|
||||
getLastId = lastId <$> getState
|
||||
|
||||
getNextIdAt sourcepos = do
|
||||
(id, map, notes) <- getState
|
||||
let newId = incId id
|
||||
let newMap = Map.insert newId sourcepos map
|
||||
putState (newId, newMap, notes)
|
||||
state <- getState
|
||||
let newId = incId (lastId state)
|
||||
let newMap = Map.insert newId sourcepos (positionMap state)
|
||||
putState $ state {
|
||||
lastId = newId,
|
||||
positionMap = newMap
|
||||
}
|
||||
return newId
|
||||
where incId (Id n) = Id $ n+1
|
||||
|
||||
|
|
@ -147,23 +162,16 @@ getNextId = do
|
|||
pos <- getPosition
|
||||
getNextIdAt pos
|
||||
|
||||
modifyMap f = do
|
||||
(id, map, parsenotes) <- getState
|
||||
putState (id, f map, parsenotes)
|
||||
|
||||
getMap = do
|
||||
(_, map, _) <- getState
|
||||
return map
|
||||
|
||||
getParseNotes = do
|
||||
(_, _, notes) <- getState
|
||||
return notes
|
||||
getMap = positionMap <$> getState
|
||||
getParseNotes = parseNotes <$> getState
|
||||
|
||||
addParseNote n = do
|
||||
irrelevant <- shouldIgnoreCode (codeForParseNote n)
|
||||
unless irrelevant $ do
|
||||
(a, b, notes) <- getState
|
||||
putState (a, b, n:notes)
|
||||
state <- getState
|
||||
putState $ state {
|
||||
parseNotes = n : parseNotes state
|
||||
}
|
||||
|
||||
shouldIgnoreCode code = do
|
||||
context <- getCurrentContexts
|
||||
|
|
@ -175,16 +183,22 @@ shouldIgnoreCode code = do
|
|||
disabling' (DisableComment n) = code == n
|
||||
|
||||
-- Store potential parse problems outside of parsec
|
||||
|
||||
data SystemState = SystemState {
|
||||
contextStack :: [Context],
|
||||
parseProblems :: [ParseNote]
|
||||
}
|
||||
initialSystemState = SystemState {
|
||||
contextStack = [],
|
||||
parseProblems = []
|
||||
}
|
||||
|
||||
parseProblem level code msg = do
|
||||
pos <- getPosition
|
||||
parseProblemAt pos level code msg
|
||||
|
||||
setCurrentContexts c =
|
||||
Ms.modify (\(list, _) -> (list, c))
|
||||
|
||||
getCurrentContexts = do
|
||||
(_, context) <- Ms.get
|
||||
return context
|
||||
setCurrentContexts c = Ms.modify (\state -> state { contextStack = c })
|
||||
getCurrentContexts = contextStack <$> Ms.get
|
||||
|
||||
popContext = do
|
||||
v <- getCurrentContexts
|
||||
|
|
@ -203,7 +217,11 @@ pushContext c = do
|
|||
parseProblemAt pos level code msg = do
|
||||
irrelevant <- shouldIgnoreCode code
|
||||
unless irrelevant $
|
||||
Ms.modify (first ((:) (ParseNote pos level code msg)))
|
||||
Ms.modify (\state -> state {
|
||||
parseProblems = note:parseProblems state
|
||||
})
|
||||
where
|
||||
note = ParseNote pos level code msg
|
||||
|
||||
-- Store non-parse problems inside
|
||||
|
||||
|
|
@ -2152,15 +2170,17 @@ readScript = do
|
|||
|
||||
readUtf8Bom = called "Byte Order Mark" $ string "\xFEFF"
|
||||
|
||||
rp p filename contents = Ms.runState (runParserT p initialState filename contents) ([], [])
|
||||
|
||||
isWarning p s = fst cs && (not . null . snd $ cs) where cs = checkString p s
|
||||
isOk p s = fst cs && (null . snd $ cs) where cs = checkString p s
|
||||
isWarning p s = parsesCleanly p s == Just False
|
||||
isOk p s = parsesCleanly p s == Just True
|
||||
|
||||
checkString parser string =
|
||||
case rp (parser >> eof >> getState) "-" string of
|
||||
(Right (tree, map, notes), (problems, _)) -> (True, notes ++ problems)
|
||||
(Left _, (n, _)) -> (False, n)
|
||||
parsesCleanly parser string = runIdentity $ do
|
||||
(res, sys) <- runParser (mockedSystemInterface [])
|
||||
(parser >> eof >> getState) "-" string
|
||||
case (res, sys) of
|
||||
(Right userState, systemState) ->
|
||||
return $ Just . null $ parseNotes userState ++ parseProblems systemState
|
||||
(Left _, _) -> return Nothing
|
||||
|
||||
parseWithNotes parser = do
|
||||
item <- parser
|
||||
|
|
@ -2172,8 +2192,6 @@ compareNotes (ParseNote pos1 level1 _ s1) (ParseNote pos2 level2 _ s2) = compare
|
|||
sortNotes = sortBy compareNotes
|
||||
|
||||
|
||||
data ParseResult = ParseResult { parseResult :: Maybe (Token, Map.Map Id SourcePos), parseNotes :: [ParseNote] } deriving (Show)
|
||||
|
||||
makeErrorFor parsecError =
|
||||
ParseNote (errorPos parsecError) ErrorC 1072 $
|
||||
getStringFromParsec $ errorMessages parsecError
|
||||
|
|
@ -2191,13 +2209,39 @@ getStringFromParsec errors =
|
|||
Message s -> if null s then Nothing else return $ s ++ "."
|
||||
unexpected s = "Unexpected " ++ (if null s then "eof" else s) ++ "."
|
||||
|
||||
parseShell options filename contents =
|
||||
case rp (parseWithNotes readScript) filename contents of
|
||||
(Right (script, map, notes), (parsenotes, _)) ->
|
||||
ParseResult (Just (script, map)) (nub . sortNotes . excludeNotes $ notes ++ parsenotes)
|
||||
(Left err, (p, context)) ->
|
||||
ParseResult Nothing
|
||||
(nub . sortNotes . excludeNotes $ p ++ notesForContext context ++ [makeErrorFor err])
|
||||
runParser :: Monad m =>
|
||||
SystemInterface m ->
|
||||
SCParser m v ->
|
||||
String ->
|
||||
String ->
|
||||
m (Either ParseError v, SystemState)
|
||||
|
||||
runParser sys p filename contents =
|
||||
Ms.runStateT
|
||||
(Mr.runReaderT
|
||||
(runParserT p initialUserState filename contents)
|
||||
sys)
|
||||
initialSystemState
|
||||
|
||||
parseShell sys contents = do
|
||||
(result, state) <- runParser sys (parseWithNotes readScript) "" contents
|
||||
case result of
|
||||
Right (script, tokenMap, notes) ->
|
||||
return ParseResult {
|
||||
prComments = map toPositionedComment $ nub $ notes ++ parseProblems state,
|
||||
prTokenPositions = Map.map posToPos tokenMap,
|
||||
prRoot = Just script
|
||||
}
|
||||
Left err ->
|
||||
return ParseResult {
|
||||
prComments =
|
||||
map toPositionedComment $
|
||||
notesForContext (contextStack state)
|
||||
++ [makeErrorFor err]
|
||||
++ parseProblems state,
|
||||
prTokenPositions = Map.empty,
|
||||
prRoot = Nothing
|
||||
}
|
||||
where
|
||||
isName (ContextName _ _) = True
|
||||
isName _ = False
|
||||
|
|
@ -2206,7 +2250,25 @@ parseShell options filename contents =
|
|||
"Couldn't parse this " ++ str ++ "."
|
||||
second (ContextName pos str) = ParseNote pos InfoC 1009 $
|
||||
"The mentioned parser error was in this " ++ str ++ "."
|
||||
excludeNotes = filter (\c -> codeForParseNote c `notElem` optionExcludes options)
|
||||
|
||||
|
||||
toPositionedComment :: ParseNote -> PositionedComment
|
||||
toPositionedComment (ParseNote pos severity code message) =
|
||||
PositionedComment (posToPos pos) $ Comment severity code message
|
||||
|
||||
posToPos :: SourcePos -> Position
|
||||
posToPos sp = Position {
|
||||
posFile = sourceName sp,
|
||||
posLine = fromIntegral $ sourceLine sp,
|
||||
posColumn = fromIntegral $ sourceColumn sp
|
||||
}
|
||||
|
||||
-- TODO: Clean up crusty old code that this is layered on top of
|
||||
parseScript :: Monad m =>
|
||||
SystemInterface m -> ParseSpec -> m ParseResult
|
||||
parseScript sys spec =
|
||||
parseShell sys (psScript spec)
|
||||
|
||||
|
||||
lt x = trace (show x) x
|
||||
ltt t = trace (show t)
|
||||
|
|
|
|||
|
|
@ -1,82 +0,0 @@
|
|||
{-
|
||||
Copyright 2012-2015 Vidar Holen
|
||||
|
||||
This file is part of ShellCheck.
|
||||
http://www.vidarholen.net/contents/shellcheck
|
||||
|
||||
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 <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage, runTests) where
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import ShellCheck.Analytics hiding (runTests)
|
||||
import ShellCheck.Options
|
||||
import ShellCheck.Parser hiding (runTests)
|
||||
import Test.QuickCheck.All (quickCheckAll)
|
||||
import Text.Parsec.Pos
|
||||
|
||||
shellCheck :: AnalysisOptions -> String -> [ShellCheckComment]
|
||||
shellCheck options script =
|
||||
let (ParseResult result notes) = parseShell options "-" script in
|
||||
let allNotes = notes ++ concat (maybeToList $ do
|
||||
(tree, posMap) <- result
|
||||
let list = runAnalytics options tree
|
||||
return $ map (noteToParseNote posMap) $ filterByAnnotation tree list
|
||||
)
|
||||
in
|
||||
map formatNote $ nub $ sortNotes allNotes
|
||||
|
||||
data ShellCheckComment = ShellCheckComment { scLine :: Int, scColumn :: Int, scSeverity :: String, scCode :: Int, scMessage :: String }
|
||||
|
||||
instance Show ShellCheckComment where
|
||||
show c = concat ["(", show $ scLine c, ",", show $ scColumn c, ") ", scSeverity c, ": ", show (scCode c), " ", scMessage c]
|
||||
|
||||
severityToString s =
|
||||
case s of
|
||||
ErrorC -> "error"
|
||||
WarningC -> "warning"
|
||||
InfoC -> "info"
|
||||
StyleC -> "style"
|
||||
|
||||
formatNote (ParseNote pos severity code text) =
|
||||
ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) (fromIntegral code) text
|
||||
|
||||
testCheck = shellCheck defaultAnalysisOptions { optionExcludes = [2148] } -- Ignore #! warnings
|
||||
prop_findsParseIssue =
|
||||
let comments = testCheck "echo \"$12\"" in
|
||||
length comments == 1 && scCode (head comments) == 1037
|
||||
prop_commentDisablesParseIssue1 =
|
||||
null $ testCheck "#shellcheck disable=SC1037\necho \"$12\""
|
||||
prop_commentDisablesParseIssue2 =
|
||||
null $ testCheck "#shellcheck disable=SC1037\n#lol\necho \"$12\""
|
||||
|
||||
prop_findsAnalysisIssue =
|
||||
let comments = testCheck "echo $1" in
|
||||
length comments == 1 && scCode (head comments) == 2086
|
||||
prop_commentDisablesAnalysisIssue1 =
|
||||
null $ testCheck "#shellcheck disable=SC2086\necho $1"
|
||||
prop_commentDisablesAnalysisIssue2 =
|
||||
null $ testCheck "#shellcheck disable=SC2086\n#lol\necho $1"
|
||||
|
||||
prop_optionDisablesIssue1 =
|
||||
null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2086, 2148] }) "echo $1"
|
||||
|
||||
prop_optionDisablesIssue2 =
|
||||
null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2148, 1037] }) "echo \"$10\""
|
||||
|
||||
return []
|
||||
runTests = $quickCheckAll
|
||||
|
||||
296
shellcheck.hs
296
shellcheck.hs
|
|
@ -17,43 +17,59 @@
|
|||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
import ShellCheck.Data
|
||||
import ShellCheck.Checker
|
||||
import ShellCheck.Interface
|
||||
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans
|
||||
import Control.Monad.Trans.Error
|
||||
import Control.Monad.Trans.List
|
||||
import Control.Monad.Except
|
||||
import Data.Char
|
||||
import Data.Functor
|
||||
import Data.Either
|
||||
import Data.IORef
|
||||
import Data.List
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import GHC.Exts
|
||||
import GHC.IO.Device
|
||||
import Prelude hiding (catch)
|
||||
import ShellCheck.Data
|
||||
import ShellCheck.Options
|
||||
import ShellCheck.Simple
|
||||
import ShellCheck.Analytics
|
||||
import System.Console.GetOpt
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.Info
|
||||
import System.IO
|
||||
import System.Info
|
||||
import Text.JSON
|
||||
import qualified Data.Map as Map
|
||||
|
||||
data Flag = Flag String String
|
||||
data Status = NoProblems | SomeProblems | BadInput | SupportFailure | SyntaxFailure | RuntimeException deriving (Ord, Eq)
|
||||
|
||||
data JsonComment = JsonComment FilePath ShellCheckComment
|
||||
|
||||
instance Error Status where
|
||||
noMsg = RuntimeException
|
||||
data Status =
|
||||
NoProblems
|
||||
| SomeProblems
|
||||
| BadInput
|
||||
| SupportFailure
|
||||
| SyntaxFailure
|
||||
| RuntimeException
|
||||
deriving (Ord, Eq)
|
||||
|
||||
instance Monoid Status where
|
||||
mempty = NoProblems
|
||||
mappend = max
|
||||
|
||||
lineNo (PositionedComment pos _) = posLine pos
|
||||
colNo (PositionedComment pos _) = posColumn pos
|
||||
codeNo (PositionedComment _ (Comment _ code _)) = code
|
||||
messageText (PositionedComment _ (Comment _ _ t)) = t
|
||||
|
||||
severityText :: PositionedComment -> String
|
||||
severityText (PositionedComment _ (Comment c _ _)) =
|
||||
case c of
|
||||
ErrorC -> "error"
|
||||
WarningC -> "warning"
|
||||
InfoC -> "info"
|
||||
StyleC -> "style"
|
||||
|
||||
header = "Usage: shellcheck [OPTIONS...] FILES..."
|
||||
options = [
|
||||
Option "e" ["exclude"]
|
||||
|
|
@ -66,51 +82,42 @@ options = [
|
|||
(NoArg $ Flag "version" "true") "Print version information"
|
||||
]
|
||||
|
||||
printErr = hPutStrLn stderr
|
||||
printOut = lift . hPutStrLn stdout
|
||||
printErr = lift . hPutStrLn stderr
|
||||
|
||||
|
||||
instance JSON (JsonComment) where
|
||||
showJSON (JsonComment filename c) = makeObj [
|
||||
("file", showJSON filename),
|
||||
("line", showJSON $ scLine c),
|
||||
("column", showJSON $ scColumn c),
|
||||
("level", showJSON $ scSeverity c),
|
||||
("code", showJSON $ scCode c),
|
||||
("message", showJSON $ scMessage c)
|
||||
instance JSON (PositionedComment) where
|
||||
showJSON comment@(PositionedComment pos (Comment level code string)) = makeObj [
|
||||
("file", showJSON $ posFile pos),
|
||||
("line", showJSON $ posLine pos),
|
||||
("column", showJSON $ posColumn pos),
|
||||
("level", showJSON $ severityText comment),
|
||||
("code", showJSON code),
|
||||
("message", showJSON string)
|
||||
]
|
||||
where
|
||||
|
||||
readJSON = undefined
|
||||
|
||||
parseArguments :: [String] -> ErrorT Status IO ([Flag], [FilePath])
|
||||
|
||||
parseArguments :: [String] -> ExceptT Status IO ([Flag], [FilePath])
|
||||
parseArguments argv =
|
||||
case getOpt Permute options argv of
|
||||
(opts, files, []) -> return (opts, files)
|
||||
(_, _, errors) -> do
|
||||
liftIO . printErr $ concat errors ++ "\n" ++ usageInfo header options
|
||||
printErr $ concat errors ++ "\n" ++ usageInfo header options
|
||||
throwError SyntaxFailure
|
||||
|
||||
formats :: Map.Map String (AnalysisOptions -> [FilePath] -> IO Status)
|
||||
formats = Map.fromList [
|
||||
{-
|
||||
("json", forJson),
|
||||
("gcc", forGcc),
|
||||
("checkstyle", forCheckstyle),
|
||||
-}
|
||||
("tty", forTty)
|
||||
]
|
||||
|
||||
toStatus = liftM (either id (const NoProblems)) . runErrorT
|
||||
|
||||
catchExceptions :: IO Status -> IO Status
|
||||
catchExceptions action = action `catch` handler
|
||||
where
|
||||
handler err = do
|
||||
printErr $ show (err :: SomeException)
|
||||
return RuntimeException
|
||||
|
||||
checkComments comments = if null comments then NoProblems else SomeProblems
|
||||
|
||||
forTty :: AnalysisOptions -> [FilePath] -> IO Status
|
||||
forTty options files = do
|
||||
output <- mapM doFile files
|
||||
return $ mconcat output
|
||||
forTty :: SystemInterface IO -> CheckSpec -> [FilePath] -> ExceptT Status IO ()
|
||||
forTty sys spec files = mapM_ doFile files
|
||||
where
|
||||
clear = ansi 0
|
||||
ansi n = "\x1B[" ++ show n ++ "m"
|
||||
|
|
@ -126,88 +133,99 @@ forTty options files = do
|
|||
colorComment level comment =
|
||||
ansi (colorForLevel level) ++ comment ++ clear
|
||||
|
||||
doFile path = catchExceptions $ do
|
||||
contents <- readContents path
|
||||
doInput path contents
|
||||
|
||||
doInput filename contents = do
|
||||
doFile filename = do
|
||||
contents <- lift $ inputFile filename
|
||||
comments <- lift (crComments <$> checkScript sys spec { csScript = contents })
|
||||
let fileLines = lines contents
|
||||
let lineCount = length fileLines
|
||||
let comments = getComments options contents
|
||||
let groups = groupWith scLine comments
|
||||
let lineCount = fromIntegral $ length fileLines
|
||||
let groups = groupWith lineNo comments
|
||||
colorFunc <- getColorFunc
|
||||
mapM_ (\x -> do
|
||||
let lineNum = scLine (head x)
|
||||
let lineNum = lineNo (head x)
|
||||
let line = if lineNum < 1 || lineNum > lineCount
|
||||
then ""
|
||||
else fileLines !! (lineNum - 1)
|
||||
putStrLn ""
|
||||
putStrLn $ colorFunc "message"
|
||||
else fileLines !! (fromIntegral $ lineNum - 1)
|
||||
printOut ""
|
||||
printOut $ colorFunc "message"
|
||||
("In " ++ filename ++" line " ++ show lineNum ++ ":")
|
||||
putStrLn (colorFunc "source" line)
|
||||
mapM_ (\c -> putStrLn (colorFunc (scSeverity c) $ cuteIndent c)) x
|
||||
putStrLn ""
|
||||
printOut (colorFunc "source" line)
|
||||
mapM_ (\c -> printOut (colorFunc (severityText c) $ cuteIndent c)) x
|
||||
printOut ""
|
||||
) groups
|
||||
return . checkComments $ comments
|
||||
|
||||
cuteIndent :: PositionedComment -> String
|
||||
cuteIndent comment =
|
||||
replicate (scColumn comment - 1) ' ' ++
|
||||
"^-- " ++ code (scCode comment) ++ ": " ++ scMessage comment
|
||||
replicate (fromIntegral $ colNo comment - 1) ' ' ++
|
||||
"^-- " ++ code (codeNo comment) ++ ": " ++ messageText comment
|
||||
|
||||
code code = "SC" ++ show code
|
||||
|
||||
getColorFunc = do
|
||||
term <- hIsTerminalDevice stdout
|
||||
term <- lift $ hIsTerminalDevice stdout
|
||||
let windows = "mingw" `isPrefixOf` os
|
||||
return $ if term && not windows then colorComment else const id
|
||||
|
||||
forJson :: AnalysisOptions -> [FilePath] -> IO Status
|
||||
forJson options files = catchExceptions $ do
|
||||
comments <- runListT $ do
|
||||
file <- ListT $ return files
|
||||
comment <- ListT $ commentsFor options file
|
||||
return $ JsonComment file comment
|
||||
putStrLn $ encodeStrict comments
|
||||
return $ checkComments comments
|
||||
{-
|
||||
forJson :: a -> Formatter
|
||||
forJson _ result = do
|
||||
let comments = concatMap getComments (crComments result)
|
||||
lift $ putStrLn $ encodeStrict comments
|
||||
where
|
||||
getComments (_, FileResult comments) = comments
|
||||
getComments (file, FileError str) = [
|
||||
PositionedComment
|
||||
Position {
|
||||
posFile = file,
|
||||
posLine = 1,
|
||||
posColumn = 1
|
||||
}
|
||||
(Comment ErrorC 1000 str)
|
||||
]
|
||||
|
||||
-- Mimic GCC "file:line:col: (error|warning|note): message" format
|
||||
forGcc :: AnalysisOptions -> [FilePath] -> IO Status
|
||||
forGcc options files = do
|
||||
files <- mapM process files
|
||||
return $ mconcat files
|
||||
forGcc :: SystemInterface IO -> Formatter
|
||||
forGcc io result = do
|
||||
mapM_ (uncurry process) (crComments result)
|
||||
where
|
||||
process file = catchExceptions $ do
|
||||
contents <- readContents file
|
||||
let comments = makeNonVirtual (getComments options contents) contents
|
||||
mapM_ (putStrLn . format file) comments
|
||||
return $ checkComments comments
|
||||
process filename (FileError string) = do
|
||||
printErr $ string
|
||||
|
||||
process filename (FileResult result) = do
|
||||
fileInput <- lift $ siReadFile io filename
|
||||
when (isLeft fileInput) $ do
|
||||
printErr $ "Failed to re-open " ++ filename
|
||||
throwError RuntimeException
|
||||
let contents = fromRight fileInput
|
||||
let comments = makeNonVirtual result contents
|
||||
mapM_ (printOut . format filename) comments
|
||||
|
||||
format filename c = concat [
|
||||
filename, ":",
|
||||
show $ scLine c, ":",
|
||||
show $ scColumn c, ": ",
|
||||
case scSeverity c of
|
||||
show $ lineNo c, ":",
|
||||
show $ colNo c, ": ",
|
||||
case severityText c of
|
||||
"error" -> "error"
|
||||
"warning" -> "warning"
|
||||
_ -> "note",
|
||||
": ",
|
||||
concat . lines $ scMessage c,
|
||||
" [SC", show $ scCode c, "]"
|
||||
concat . lines $ messageText c,
|
||||
" [SC", show $ codeNo c, "]"
|
||||
]
|
||||
|
||||
-- Checkstyle compatible output. A bit of a hack to avoid XML dependencies
|
||||
forCheckstyle :: AnalysisOptions -> [FilePath] -> IO Status
|
||||
forCheckstyle options files = do
|
||||
putStrLn "<?xml version='1.0' encoding='UTF-8'?>"
|
||||
putStrLn "<checkstyle version='4.3'>"
|
||||
statuses <- mapM process files
|
||||
putStrLn "</checkstyle>"
|
||||
forCheckstyle :: SystemInterface IO -> Formatter
|
||||
forCheckstyle _ result = do
|
||||
printOut "<?xml version='1.0' encoding='UTF-8'?>"
|
||||
printOut "<checkstyle version='4.3'>"
|
||||
statuses <- mapM process (crComments result)
|
||||
printOut "</checkstyle>"
|
||||
return $ mconcat statuses
|
||||
where
|
||||
process file = catchExceptions $ do
|
||||
comments <- commentsFor options file
|
||||
putStrLn (formatFile file comments)
|
||||
return $ checkComments comments
|
||||
process (file, FileError str) =
|
||||
printOut (formatError file str)
|
||||
|
||||
process (file, FileResult comments) =
|
||||
printOut (formatFile file comments)
|
||||
|
||||
severity "error" = "error"
|
||||
severity "warning" = "warning"
|
||||
|
|
@ -225,35 +243,39 @@ forCheckstyle options files = do
|
|||
|
||||
format c = concat [
|
||||
"<error ",
|
||||
attr "line" $ show . scLine $ c,
|
||||
attr "column" $ show . scColumn $ c,
|
||||
attr "severity" $ severity . scSeverity $ c,
|
||||
attr "message" $ scMessage c,
|
||||
attr "source" $ "ShellCheck.SC" ++ show (scCode c),
|
||||
attr "line" $ show . lineNo $ c,
|
||||
attr "column" $ show . colNo $ c,
|
||||
attr "severity" . severity $ severityText c,
|
||||
attr "message" $ messageText c,
|
||||
attr "source" $ "ShellCheck.SC" ++ show (codeNo c),
|
||||
"/>\n"
|
||||
]
|
||||
|
||||
commentsFor options file = liftM (getComments options) $ readContents file
|
||||
formatError file msg = concat [
|
||||
"<file ", attr "name" file, ">\n",
|
||||
"<error ",
|
||||
attr "line" "1",
|
||||
attr "column" "1",
|
||||
attr "severity" $ severity "error",
|
||||
attr "message" msg,
|
||||
attr "source" "ShellCheck",
|
||||
"/>\n",
|
||||
"</file>"
|
||||
]
|
||||
-}
|
||||
|
||||
getComments = shellCheck
|
||||
|
||||
readContents :: FilePath -> IO String
|
||||
readContents file =
|
||||
if file == "-"
|
||||
then getContents
|
||||
else readFile file
|
||||
|
||||
-- Realign comments from a tabstop of 8 to 1
|
||||
makeNonVirtual comments contents =
|
||||
map fix comments
|
||||
where
|
||||
ls = lines contents
|
||||
fix c = c {
|
||||
scColumn =
|
||||
if scLine c > 0 && scLine c <= length ls
|
||||
then real (ls !! (scLine c - 1)) 0 0 (scColumn c)
|
||||
else scColumn c
|
||||
}
|
||||
fix c@(PositionedComment pos comment) = PositionedComment pos {
|
||||
posColumn =
|
||||
if lineNo c > 0 && lineNo c <= fromIntegral (length ls)
|
||||
then real (ls !! (fromIntegral $ lineNo c - 1)) 0 0 (colNo c)
|
||||
else colNo c
|
||||
} comment
|
||||
real _ r v target | target <= v = r
|
||||
real [] r v _ = r -- should never happen
|
||||
real ('\t':rest) r v target =
|
||||
|
|
@ -285,7 +307,9 @@ getExclusions options =
|
|||
excludeCodes codes =
|
||||
filter (not . hasCode)
|
||||
where
|
||||
hasCode c = scCode c `elem` codes
|
||||
hasCode c = codeNo c `elem` codes
|
||||
|
||||
toStatus = liftM (either id (const NoProblems)) . runExceptT
|
||||
|
||||
main = do
|
||||
args <- getArgs
|
||||
|
|
@ -303,32 +327,34 @@ statusToCode status =
|
|||
SupportFailure -> ExitFailure 4
|
||||
RuntimeException -> ExitFailure 2
|
||||
|
||||
process :: [Flag] -> [FilePath] -> ErrorT Status IO ()
|
||||
process :: [Flag] -> [FilePath] -> ExceptT Status IO ()
|
||||
process flags files = do
|
||||
options <- foldM (flip parseOption) defaultAnalysisOptions flags
|
||||
options <- foldM (flip parseOption) emptyCheckSpec flags
|
||||
verifyFiles files
|
||||
let format = fromMaybe "tty" $ getOption flags "format"
|
||||
formatter <-
|
||||
case Map.lookup format formats of
|
||||
Nothing -> do
|
||||
liftIO $ do
|
||||
printErr $ "Unknown format " ++ format
|
||||
printErr "Supported formats:"
|
||||
mapM_ (printErr . write) $ Map.keys formats
|
||||
throwError SupportFailure
|
||||
where write s = " " ++ s
|
||||
Just f -> ErrorT $ liftM Left $ f options files
|
||||
Just f -> ExceptT $ fmap Right $ return f
|
||||
let sys = ioInterface (const False)
|
||||
formatter sys options files
|
||||
|
||||
parseOption flag options =
|
||||
case flag of
|
||||
Flag "shell" str ->
|
||||
fromMaybe (die $ "Unknown shell: " ++ str) $ do
|
||||
shell <- shellForExecutable str
|
||||
return $ return options { optionShellType = Just shell }
|
||||
return $ return options { csShellTypeOverride = Just shell }
|
||||
|
||||
Flag "exclude" str -> do
|
||||
new <- mapM parseNum $ split ',' str
|
||||
let old = optionExcludes options
|
||||
return options { optionExcludes = new ++ old }
|
||||
let old = csExcludedWarnings options
|
||||
return options { csExcludedWarnings = new ++ old }
|
||||
|
||||
Flag "version" _ -> do
|
||||
liftIO printVersion
|
||||
|
|
@ -337,19 +363,39 @@ parseOption flag options =
|
|||
_ -> return options
|
||||
where
|
||||
die s = do
|
||||
liftIO $ printErr s
|
||||
printErr s
|
||||
throwError SupportFailure
|
||||
parseNum ('S':'C':str) = parseNum str
|
||||
parseNum num = do
|
||||
unless (all isDigit num) $ do
|
||||
liftIO . printErr $ "Bad exclusion: " ++ num
|
||||
printErr $ "Bad exclusion: " ++ num
|
||||
throwError SyntaxFailure
|
||||
return (Prelude.read num :: Integer)
|
||||
|
||||
ioInterface filter = do
|
||||
SystemInterface {
|
||||
siReadFile = get
|
||||
}
|
||||
where
|
||||
get file = do
|
||||
if filter file
|
||||
then (Right <$> inputFile file) `catch` handler
|
||||
else return $ Left (file ++ " was not specified as input.")
|
||||
|
||||
handler :: IOException -> IO (Either ErrorMessage String)
|
||||
handler ex = return . Left $ show ex
|
||||
|
||||
inputFile file = do
|
||||
contents <-
|
||||
if file == "-"
|
||||
then getContents
|
||||
else readFile file
|
||||
return contents
|
||||
|
||||
verifyFiles files =
|
||||
when (null files) $ do
|
||||
liftIO $ printErr "No files specified.\n"
|
||||
liftIO $ printErr $ usageInfo header options
|
||||
printErr "No files specified.\n"
|
||||
printErr $ usageInfo header options
|
||||
throwError SyntaxFailure
|
||||
|
||||
printVersion = do
|
||||
|
|
|
|||
|
|
@ -2,15 +2,17 @@ module Main where
|
|||
|
||||
import Control.Monad
|
||||
import System.Exit
|
||||
import qualified ShellCheck.Simple
|
||||
import qualified ShellCheck.Checker
|
||||
import qualified ShellCheck.Analytics
|
||||
import qualified ShellCheck.Parser
|
||||
|
||||
main = do
|
||||
putStrLn "Running ShellCheck tests..."
|
||||
results <- sequence [ShellCheck.Simple.runTests,
|
||||
results <- sequence [
|
||||
ShellCheck.Checker.runTests,
|
||||
ShellCheck.Analytics.runTests,
|
||||
ShellCheck.Parser.runTests]
|
||||
if and results then exitSuccess
|
||||
ShellCheck.Parser.runTests
|
||||
]
|
||||
if and results
|
||||
then exitSuccess
|
||||
else exitFailure
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue