diff --git a/ShellCheck.cabal b/ShellCheck.cabal
index 0a751a6..9990531 100644
--- a/ShellCheck.cabal
+++ b/ShellCheck.cabal
@@ -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
diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs
index 4eee9e5..b39b2f8 100644
--- a/ShellCheck/Analytics.hs
+++ b/ShellCheck/Analytics.hs
@@ -18,10 +18,17 @@
along with this program. If not, see .
-}
{-# 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
+runAnalytics :: AnalysisSpec -> AnalysisResult
+runAnalytics options = AnalysisResult {
+ arComments =
+ nub . filterByAnnotation (asScript options) $
+ runList options treeChecks
+ }
-runList options root list = notes
+runList :: AnalysisSpec -> [Parameters -> Token -> [TokenComment]]
+ -> [TokenComment]
+runList spec list = notes
where
+ root = asScript spec
params = Parameters {
- shellType = fromMaybe (determineShell root) $ optionShellType options,
- shellTypeSpecified = isJust $ optionShellType options,
+ shellType = fromMaybe (determineShell root) $ asShellType spec,
+ shellTypeSpecified = isJust $ asShellType spec,
parentMap = getParentTree root,
- variableFlow = getVariableFlow (shellType params) (parentMap params) root
+ variableFlow =
+ getVariableFlow (shellType params) (parentMap params) root
}
- notes = filter (\c -> getCode c `notElem` optionExcludes options) $ concatMap (\f -> f params root) list
- getCode (Note _ _ c _) = c
+ 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 [])
diff --git a/ShellCheck/Analyzer.hs b/ShellCheck/Analyzer.hs
new file mode 100644
index 0000000..1363065
--- /dev/null
+++ b/ShellCheck/Analyzer.hs
@@ -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 .
+-}
+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
diff --git a/ShellCheck/Checker.hs b/ShellCheck/Checker.hs
new file mode 100644
index 0000000..7700c56
--- /dev/null
+++ b/ShellCheck/Checker.hs
@@ -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 .
+-}
+{-# 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
diff --git a/ShellCheck/Data.hs b/ShellCheck/Data.hs
index 39af73f..bcbf0dc 100644
--- a/ShellCheck/Data.hs
+++ b/ShellCheck/Data.hs
@@ -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
diff --git a/ShellCheck/Interface.hs b/ShellCheck/Interface.hs
new file mode 100644
index 0000000..6616915
--- /dev/null
+++ b/ShellCheck/Interface.hs
@@ -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 .
+-}
+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
+
diff --git a/ShellCheck/Options.hs b/ShellCheck/Options.hs
deleted file mode 100644
index 5966e4a..0000000
--- a/ShellCheck/Options.hs
+++ /dev/null
@@ -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 = []
-}
diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs
index ed38474..666d376 100644
--- a/ShellCheck/Parser.hs
+++ b/ShellCheck/Parser.hs
@@ -18,19 +18,21 @@
along with this program. If not, see .
-}
{-# 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)
diff --git a/ShellCheck/Simple.hs b/ShellCheck/Simple.hs
deleted file mode 100644
index 4746a4c..0000000
--- a/ShellCheck/Simple.hs
+++ /dev/null
@@ -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 .
--}
-{-# 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
-
diff --git a/shellcheck.hs b/shellcheck.hs
index 6bea5e2..130d1d9 100644
--- a/shellcheck.hs
+++ b/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 .
-}
+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 ""
- putStrLn ""
- statuses <- mapM process files
- putStrLn ""
+forCheckstyle :: SystemInterface IO -> Formatter
+forCheckstyle _ result = do
+ printOut ""
+ printOut ""
+ statuses <- mapM process (crComments result)
+ printOut ""
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 [
"\n"
]
-commentsFor options file = liftM (getComments options) $ readContents file
+ formatError file msg = concat [
+ "\n",
+ "\n",
+ ""
+ ]
+-}
-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"
- case Map.lookup format formats of
- Nothing -> do
- liftIO $ do
+ formatter <-
+ case Map.lookup format formats of
+ Nothing -> 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
+ throwError SupportFailure
+ where write s = " " ++ s
+ 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 }
+ fromMaybe (die $ "Unknown shell: " ++ str) $ do
+ shell <- shellForExecutable str
+ 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
diff --git a/test/shellcheck.hs b/test/shellcheck.hs
index bb58fbc..6ac02af 100644
--- a/test/shellcheck.hs
+++ b/test/shellcheck.hs
@@ -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,
- ShellCheck.Analytics.runTests,
- ShellCheck.Parser.runTests]
- if and results then exitSuccess
- else exitFailure
-
+ results <- sequence [
+ ShellCheck.Checker.runTests,
+ ShellCheck.Analytics.runTests,
+ ShellCheck.Parser.runTests
+ ]
+ if and results
+ then exitSuccess
+ else exitFailure