7x31
/
shellcheck
mirror of https://github.com/koalaman/shellcheck.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #1168 from vmchale/master 

Bump to ghc 8.4.1
This commit is contained in:
Vidar Holen 2018-04-22 14:10:25 -07:00 committed by GitHub
parent 32af2783f0 08aab3c161
commit ce7658ed86
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 136 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ShellCheck.cabal
View File

@ -43,6 +43,9 @@ source-repository head
library library
hs-source-dirs: src hs-source-dirs: src
if impl(ghc < 8.0)
build-depends:
semigroups
build-depends: build-depends:
-- GHC 7.6.3 (base 4.6.0.1) is buggy (#1131, #1119) in optimized mode. -- GHC 7.6.3 (base 4.6.0.1) is buggy (#1131, #1119) in optimized mode.
-- Just disable that version entirely to fail fast. -- Just disable that version entirely to fail fast.
@ -78,6 +81,9 @@ library
Paths_ShellCheck Paths_ShellCheck
executable shellcheck executable shellcheck
if impl(ghc < 8.0)
build-depends:
semigroups
build-depends: build-depends:
base >= 4 && < 5, base >= 4 && < 5,
ShellCheck, ShellCheck,

80
shellcheck.hs
View File

@ -17,35 +17,36 @@
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
import ShellCheck.Data import ShellCheck.Checker
import ShellCheck.Checker import ShellCheck.Data
import ShellCheck.Interface import ShellCheck.Interface
import ShellCheck.Regex import ShellCheck.Regex
import ShellCheck.Formatter.Format
import qualified ShellCheck.Formatter.CheckStyle import qualified ShellCheck.Formatter.CheckStyle
import ShellCheck.Formatter.Format
import qualified ShellCheck.Formatter.GCC import qualified ShellCheck.Formatter.GCC
import qualified ShellCheck.Formatter.JSON import qualified ShellCheck.Formatter.JSON
import qualified ShellCheck.Formatter.TTY import qualified ShellCheck.Formatter.TTY
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.Except import Control.Monad.Except
import Data.Bits import Data.Bits
import Data.Char import Data.Char
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.IORef import Data.IORef
import Data.List import Data.List
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Prelude hiding (catch) import Data.Semigroup (Semigroup (..))
import System.Console.GetOpt import Prelude hiding (catch)
import System.Directory import System.Console.GetOpt
import System.Environment import System.Directory
import System.Exit import System.Environment
import System.IO import System.Exit
import System.IO
data Flag = Flag String String data Flag = Flag String String
data Status = data Status =
@ -56,13 +57,16 @@ data Status =
| RuntimeException | RuntimeException
deriving (Ord, Eq, Show) deriving (Ord, Eq, Show)
instance Semigroup Status where
(<>) = max
instance Monoid Status where instance Monoid Status where
mempty = NoProblems mempty = NoProblems
mappend = max mappend = (Data.Semigroup.<>)
data Options = Options { data Options = Options {
checkSpec :: CheckSpec, checkSpec :: CheckSpec,
externalSources :: Bool, externalSources :: Bool,
formatterOptions :: FormatterOptions formatterOptions :: FormatterOptions
} }
@ -117,9 +121,9 @@ formatList = intercalate ", " names
where where
names = Map.keys $ formats (formatterOptions defaultOptions) names = Map.keys $ formats (formatterOptions defaultOptions)
getOption [] _ = Nothing getOption [] _ = Nothing
getOption (Flag var val:_) name | name == var = return val getOption (Flag var val:_) name | name == var = return val
getOption (_:rest) flag = getOption rest flag getOption (_:rest) flag = getOption rest flag
getOptions options name = getOptions options name =
map (\(Flag _ val) -> val) . filter (\(Flag var _) -> var == name) $ options map (\(Flag _ val) -> val) . filter (\(Flag var _) -> var == name) $ options
@ -159,10 +163,10 @@ main = do
statusToCode status = statusToCode status =
case status of case status of
NoProblems -> ExitSuccess NoProblems -> ExitSuccess
SomeProblems -> ExitFailure 1 SomeProblems -> ExitFailure 1
SyntaxFailure -> ExitFailure 3 SyntaxFailure -> ExitFailure 3
SupportFailure -> ExitFailure 4 SupportFailure -> ExitFailure 4
RuntimeException -> ExitFailure 2 RuntimeException -> ExitFailure 2
process :: [Flag] -> [FilePath] -> ExceptT Status IO Status process :: [Flag] -> [FilePath] -> ExceptT Status IO Status
@ -203,7 +207,7 @@ runFormatter sys format options files = do
process :: FilePath -> IO Status process :: FilePath -> IO Status
process filename = do process filename = do
input <- (siReadFile sys) filename input <- siReadFile sys filename
either (reportFailure filename) check input either (reportFailure filename) check input
where where
check contents = do check contents = do
@ -220,10 +224,10 @@ runFormatter sys format options files = do
parseColorOption colorOption = parseColorOption colorOption =
case colorOption of case colorOption of
"auto" -> ColorAuto "auto" -> ColorAuto
"always" -> ColorAlways "always" -> ColorAlways
"never" -> ColorNever "never" -> ColorNever
_ -> error $ "Bad value for --color `" ++ colorOption ++ "'" _ -> error $ "Bad value for --color `" ++ colorOption ++ "'"
parseOption flag options = parseOption flag options =
case flag of case flag of
@ -292,7 +296,7 @@ ioInterface options files = do
get cache inputs file = do get cache inputs file = do
map <- readIORef cache map <- readIORef cache
case Map.lookup file map of case Map.lookup file map of
Just x -> return $ Right x Just x -> return $ Right x
Nothing -> fetch cache inputs file Nothing -> fetch cache inputs file
fetch cache inputs file = do fetch cache inputs file = do
@ -355,7 +359,7 @@ decodeString = decode
in in
case next of case next of
Just (n, remainder) -> chr n : decode remainder Just (n, remainder) -> chr n : decode remainder
Nothing -> c : decode rest Nothing -> c : decode rest
construct x 0 rest = do construct x 0 rest = do
guard $ x <= 0x10FFFF guard $ x <= 0x10FFFF

173
src/ShellCheck/AnalyzerLib.hs
View File

@ -17,28 +17,30 @@
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
module ShellCheck.AnalyzerLib where module ShellCheck.AnalyzerLib where
import ShellCheck.AST import ShellCheck.AST
import ShellCheck.ASTLib import ShellCheck.ASTLib
import ShellCheck.Data import ShellCheck.Data
import ShellCheck.Interface import ShellCheck.Interface
import ShellCheck.Parser import ShellCheck.Parser
import ShellCheck.Regex import ShellCheck.Regex
import Control.Arrow (first) import Control.Arrow (first)
import Control.Monad.Identity import Control.Monad.Identity
import Control.Monad.RWS import Control.Monad.RWS
import Control.Monad.State import Control.Monad.State
import Control.Monad.Writer import Control.Monad.Writer
import Data.Char import Data.Char
import Data.List import Data.List
import Data.Maybe import qualified Data.Map as Map
import qualified Data.Map as Map import Data.Maybe
import Data.Semigroup
import Test.QuickCheck.All (forAllProperties) import Test.QuickCheck.All (forAllProperties)
import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) import Test.QuickCheck.Test (maxSuccess, quickCheckWithResult,
stdArgs)
type Analysis = AnalyzerM () type Analysis = AnalyzerM ()
type AnalyzerM a = RWS Parameters [TokenComment] Cache a type AnalyzerM a = RWS Parameters [TokenComment] Cache a
@ -47,7 +49,7 @@ nullCheck = const $ return ()
data Checker = Checker { data Checker = Checker {
perScript :: Root -> Analysis, perScript :: Root -> Analysis,
perToken :: Token -> Analysis perToken :: Token -> Analysis
} }
runChecker :: Parameters -> Checker -> [TokenComment] runChecker :: Parameters -> Checker -> [TokenComment]
@ -57,28 +59,30 @@ runChecker params checker = notes
check = perScript checker `composeAnalyzers` (\(Root x) -> void $ doAnalysis (perToken checker) x) check = perScript checker `composeAnalyzers` (\(Root x) -> void $ doAnalysis (perToken checker) x)
notes = snd $ evalRWS (check $ Root root) params Cache notes = snd $ evalRWS (check $ Root root) params Cache
instance Semigroup Checker where
(<>) x y = Checker {
perScript = perScript x `composeAnalyzers` perScript y,
perToken = perToken x `composeAnalyzers` perToken y
}
instance Monoid Checker where instance Monoid Checker where
mempty = Checker { mempty = Checker {
perScript = nullCheck, perScript = nullCheck,
perToken = nullCheck perToken = nullCheck
} }
mappend x y = Checker { mappend = (Data.Semigroup.<>)
perScript = perScript x `composeAnalyzers` perScript y,
perToken = perToken x `composeAnalyzers` perToken y
}
composeAnalyzers :: (a -> Analysis) -> (a -> Analysis) -> a -> Analysis composeAnalyzers :: (a -> Analysis) -> (a -> Analysis) -> a -> Analysis
composeAnalyzers f g x = f x >> g x composeAnalyzers f g x = f x >> g x
data Parameters = Parameters { data Parameters = Parameters {
hasLastpipe :: Bool, -- Whether this script has the 'lastpipe' option set/default. hasLastpipe :: Bool, -- Whether this script has the 'lastpipe' option set/default.
hasSetE :: Bool, -- Whether this script has 'set -e' anywhere. hasSetE :: Bool, -- Whether this script has 'set -e' anywhere.
variableFlow :: [StackData], -- A linear (bad) analysis of data flow variableFlow :: [StackData], -- A linear (bad) analysis of data flow
parentMap :: Map.Map Id Token, -- A map from Id to parent Token parentMap :: Map.Map Id Token, -- A map from Id to parent Token
shellType :: Shell, -- The shell type, such as Bash or Ksh shellType :: Shell, -- The shell type, such as Bash or Ksh
shellTypeSpecified :: Bool, -- True if shell type was forced via flags shellTypeSpecified :: Bool, -- True if shell type was forced via flags
rootNode :: Token -- The root node of the AST rootNode :: Token -- The root node of the AST
} }
-- TODO: Cache results of common AST ops here -- TODO: Cache results of common AST ops here
@ -151,8 +155,8 @@ makeParameters spec =
case shellType params of case shellType params of
Bash -> containsLastpipe root Bash -> containsLastpipe root
Dash -> False Dash -> False
Sh -> False Sh -> False
Ksh -> True, Ksh -> True,
shellTypeSpecified = isJust $ asShellType spec, shellTypeSpecified = isJust $ asShellType spec,
parentMap = getParentTree root, parentMap = getParentTree root,
@ -205,7 +209,7 @@ determineShell t = fromMaybe Bash $ do
forAnnotation t = forAnnotation t =
case t of case t of
(ShellOverride s) -> return s (ShellOverride s) -> return s
_ -> fail "" _ -> fail ""
getCandidates :: Token -> [Maybe String] getCandidates :: Token -> [Maybe String]
getCandidates t@T_Script {} = [Just $ fromShebang t] getCandidates t@T_Script {} = [Just $ fromShebang t]
getCandidates (T_Annotation _ annotations s) = getCandidates (T_Annotation _ annotations s) =
@ -233,7 +237,7 @@ getParentTree t =
pre t = modify (first ((:) t)) pre t = modify (first ((:) t))
post t = do post t = do
(_:rest, map) <- get (_:rest, map) <- get
case rest of [] -> put (rest, map) case rest of [] -> put (rest, map)
(x:_) -> put (rest, Map.insert (getId t) x map) (x:_) -> put (rest, Map.insert (getId t) x map)
-- Given a root node, make a map from Id to Token -- Given a root node, make a map from Id to Token
@ -264,27 +268,27 @@ isQuoteFreeNode strict tree t =
case t of case t of
T_Assignment {} -> return True T_Assignment {} -> return True
T_FdRedirect {} -> return True T_FdRedirect {} -> return True
_ -> Nothing _ -> Nothing
-- Are any subnodes inherently self-quoting? -- Are any subnodes inherently self-quoting?
isQuoteFreeContext t = isQuoteFreeContext t =
case t of case t of
TC_Nullary _ DoubleBracket _ -> return True TC_Nullary _ DoubleBracket _ -> return True
TC_Unary _ DoubleBracket _ _ -> return True TC_Unary _ DoubleBracket _ _ -> return True
TC_Binary _ DoubleBracket _ _ _ -> return True TC_Binary _ DoubleBracket _ _ _ -> return True
TA_Sequence {} -> return True TA_Sequence {} -> return True
T_Arithmetic {} -> return True T_Arithmetic {} -> return True
T_Assignment {} -> return True T_Assignment {} -> return True
T_Redirecting {} -> return False T_Redirecting {} -> return False
T_DoubleQuoted _ _ -> return True T_DoubleQuoted _ _ -> return True
T_DollarDoubleQuoted _ _ -> return True T_DollarDoubleQuoted _ _ -> return True
T_CaseExpression {} -> return True T_CaseExpression {} -> return True
T_HereDoc {} -> return True T_HereDoc {} -> return True
T_DollarBraced {} -> return True T_DollarBraced {} -> return True
-- When non-strict, pragmatically assume it's desirable to split here -- When non-strict, pragmatically assume it's desirable to split here
T_ForIn {} -> return (not strict) T_ForIn {} -> return (not strict)
T_SelectIn {} -> return (not strict) T_SelectIn {} -> return (not strict)
_ -> Nothing _ -> Nothing
-- Check if a token is a parameter to a certain command by name: -- Check if a token is a parameter to a certain command by name:
-- Example: isParamTo (parentMap params) "sed" t -- Example: isParamTo (parentMap params) "sed" t
@ -293,16 +297,16 @@ isParamTo tree cmd =
go go
where where
go x = case Map.lookup (getId x) tree of go x = case Map.lookup (getId x) tree of
Nothing -> False Nothing -> False
Just parent -> check parent Just parent -> check parent
check t = check t =
case t of case t of
T_SingleQuoted _ _ -> go t T_SingleQuoted _ _ -> go t
T_DoubleQuoted _ _ -> go t T_DoubleQuoted _ _ -> go t
T_NormalWord _ _ -> go t T_NormalWord _ _ -> go t
T_SimpleCommand {} -> isCommand t cmd T_SimpleCommand {} -> isCommand t cmd
T_Redirecting {} -> isCommand t cmd T_Redirecting {} -> isCommand t cmd
_ -> False _ -> False
-- Get the parent command (T_Redirecting) of a Token, if any. -- Get the parent command (T_Redirecting) of a Token, if any.
getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token
@ -312,8 +316,8 @@ getClosestCommand tree t =
findCommand t = findCommand t =
case t of case t of
T_Redirecting {} -> return True T_Redirecting {} -> return True
T_Script {} -> return False T_Script {} -> return False
_ -> Nothing _ -> Nothing
-- Like above, if koala_man knew Haskell when starting this project. -- Like above, if koala_man knew Haskell when starting this project.
getClosestCommandM t = do getClosestCommandM t = do
@ -334,7 +338,7 @@ usedAsCommandName tree token = go (getId token) (tail $ getPath tree token)
-- A list of the element and all its parents up to the root node. -- A list of the element and all its parents up to the root node.
getPath tree t = t : getPath tree t = t :
case Map.lookup (getId t) tree of case Map.lookup (getId t) tree of
Nothing -> [] Nothing -> []
Just parent -> getPath tree parent Just parent -> getPath tree parent
-- Version of the above taking the map from the current context -- Version of the above taking the map from the current context
@ -360,9 +364,9 @@ findFirst p l =
[] -> Nothing [] -> Nothing
(x:xs) -> (x:xs) ->
case p x of case p x of
Just True -> return x Just True -> return x
Just False -> Nothing Just False -> Nothing
Nothing -> findFirst p xs Nothing -> findFirst p xs
-- Check whether a word is entirely output from a single command -- Check whether a word is entirely output from a single command
tokenIsJustCommandOutput t = case t of tokenIsJustCommandOutput t = case t of
@ -373,7 +377,7 @@ tokenIsJustCommandOutput t = case t of
_ -> False _ -> False
where where
check [x] = not $ isOnlyRedirection x check [x] = not $ isOnlyRedirection x
check _ = False check _ = False
-- TODO: Replace this with a proper Control Flow Graph -- TODO: Replace this with a proper Control Flow Graph
getVariableFlow params t = getVariableFlow params t =
@ -393,9 +397,9 @@ getVariableFlow params t =
unless (assignFirst t) $ setWritten t unless (assignFirst t) $ setWritten t
when (scopeType /= NoneScope) $ modify (StackScopeEnd:) when (scopeType /= NoneScope) $ modify (StackScopeEnd:)
assignFirst T_ForIn {} = True assignFirst T_ForIn {} = True
assignFirst T_SelectIn {} = True assignFirst T_SelectIn {} = True
assignFirst _ = False assignFirst _ = False
setRead t = setRead t =
let read = getReferencedVariables (parentMap params) t let read = getReferencedVariables (parentMap params) t
@ -423,7 +427,7 @@ leadType params t =
parent <- Map.lookup (getId t) (parentMap params) parent <- Map.lookup (getId t) (parentMap params)
case parent of case parent of
T_Pipeline {} -> return parent T_Pipeline {} -> return parent
_ -> Nothing _ -> Nothing
causesSubshell = do causesSubshell = do
(T_Pipeline _ _ list) <- parentPipeline (T_Pipeline _ _ list) <- parentPipeline
@ -459,10 +463,10 @@ getModifiedVariables t =
flip getLiteralStringExt token $ \x -> flip getLiteralStringExt token $ \x ->
case x of case x of
T_Glob _ s -> return s -- Unquoted index T_Glob _ s -> return s -- Unquoted index
_ -> Nothing _ -> Nothing
guard . not . null $ str guard . not . null $ str
return (t, token, str, DataString $ SourceChecked) return (t, token, str, DataString SourceChecked)
T_DollarBraced _ l -> maybeToList $ do T_DollarBraced _ l -> maybeToList $ do
let string = bracedString t let string = bracedString t
@ -486,7 +490,7 @@ isClosingFileOp op =
case op of case op of
T_IoDuplicate _ (T_GREATAND _) "-" -> True T_IoDuplicate _ (T_GREATAND _) "-" -> True
T_IoDuplicate _ (T_LESSAND _) "-" -> True T_IoDuplicate _ (T_LESSAND _) "-" -> True
_ -> False _ -> False
-- Consider 'export/declare -x' a reference, since it makes the var available -- Consider 'export/declare -x' a reference, since it makes the var available
@ -524,7 +528,7 @@ getModifiedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal
"getopts" -> "getopts" ->
case rest of case rest of
opts:var:_ -> maybeToList $ getLiteral var opts:var:_ -> maybeToList $ getLiteral var
_ -> [] _ -> []
"let" -> concatMap letParamToLiteral rest "let" -> concatMap letParamToLiteral rest
@ -588,9 +592,9 @@ getModifiedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal
getSetParams (t:rest) = getSetParams (t:rest) =
let s = getLiteralString t in let s = getLiteralString t in
case s of case s of
Just "--" -> return rest Just "--" -> return rest
Just ('-':_) -> getSetParams rest Just ('-':_) -> getSetParams rest
_ -> return (t:fromMaybe [] (getSetParams rest)) _ -> return (t:fromMaybe [] (getSetParams rest))
getSetParams [] = Nothing getSetParams [] = Nothing
getPrintfVariable list = f $ map (\x -> (x, getLiteralString x)) list getPrintfVariable list = f $ map (\x -> (x, getLiteralString x)) list
@ -662,7 +666,7 @@ getReferencedVariables parents t =
literalizer t = case t of literalizer t = case t of
T_Glob _ s -> return s -- Also when parsed as globs T_Glob _ s -> return s -- Also when parsed as globs
_ -> Nothing _ -> Nothing
getIfReference context token = maybeToList $ do getIfReference context token = maybeToList $ do
str <- getLiteralStringExt literalizer token str <- getLiteralStringExt literalizer token
@ -674,7 +678,7 @@ getReferencedVariables parents t =
isArithmeticAssignment t = case getPath parents t of isArithmeticAssignment t = case getPath parents t of
this: TA_Assignment _ "=" lhs _ :_ -> lhs == t this: TA_Assignment _ "=" lhs _ :_ -> lhs == t
_ -> False _ -> False
dataTypeFrom defaultType v = (case v of T_Array {} -> DataArray; _ -> defaultType) $ SourceFrom [v] dataTypeFrom defaultType v = (case v of T_Array {} -> DataArray; _ -> defaultType) $ SourceFrom [v]
@ -687,9 +691,8 @@ isCommand token str = isCommandMatch token (\cmd -> cmd == str || ('/' : str) `
-- Compare a command to a literal. Like above, but checks full path. -- Compare a command to a literal. Like above, but checks full path.
isUnqualifiedCommand token str = isCommandMatch token (== str) isUnqualifiedCommand token str = isCommandMatch token (== str)
isCommandMatch token matcher = fromMaybe False $ do isCommandMatch token matcher = fromMaybe False $
cmd <- getCommandName token fmap matcher (getCommandName token)
return $ matcher cmd
-- Does this regex look like it was intended as a glob? -- Does this regex look like it was intended as a glob?
-- True: *foo* -- True: *foo*
@ -697,7 +700,7 @@ isCommandMatch token matcher = fromMaybe False $ do
isConfusedGlobRegex :: String -> Bool isConfusedGlobRegex :: String -> Bool
isConfusedGlobRegex ('*':_) = True isConfusedGlobRegex ('*':_) = True
isConfusedGlobRegex [x,'*'] | x /= '\\' = True isConfusedGlobRegex [x,'*'] | x /= '\\' = True
isConfusedGlobRegex _ = False isConfusedGlobRegex _ = False
isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
isVariableChar x = isVariableStartChar x || isDigit x isVariableChar x = isVariableStartChar x || isDigit x
@ -707,7 +710,7 @@ prop_isVariableName1 = isVariableName "_fo123"
prop_isVariableName2 = not $ isVariableName "4" prop_isVariableName2 = not $ isVariableName "4"
prop_isVariableName3 = not $ isVariableName "test: " prop_isVariableName3 = not $ isVariableName "test: "
isVariableName (x:r) = isVariableStartChar x && all isVariableChar r isVariableName (x:r) = isVariableStartChar x && all isVariableChar r
isVariableName _ = False isVariableName _ = False
getVariablesFromLiteralToken token = getVariablesFromLiteralToken token =
getVariablesFromLiteral (fromJust $ getLiteralStringExt (const $ return " ") token) getVariablesFromLiteral (fromJust $ getLiteralStringExt (const $ return " ") token)
@ -740,7 +743,7 @@ getBracedReference s = fromMaybe s $
where where
noPrefix = dropPrefix s noPrefix = dropPrefix s
dropPrefix (c:rest) = if c `elem` "!#" then rest else c:rest dropPrefix (c:rest) = if c `elem` "!#" then rest else c:rest
dropPrefix "" = "" dropPrefix "" = ""
takeName s = do takeName s = do
let name = takeWhile isVariableChar s let name = takeWhile isVariableChar s
guard . not $ null name guard . not $ null name
@ -765,12 +768,12 @@ getBracedModifier s = fromMaybe "" . listToMaybe $ do
a <- dropModifier s a <- dropModifier s
dropPrefix var a dropPrefix var a
where where
dropPrefix [] t = return t dropPrefix [] t = return t
dropPrefix (a:b) (c:d) | a == c = dropPrefix b d dropPrefix (a:b) (c:d) | a == c = dropPrefix b d
dropPrefix _ _ = [] dropPrefix _ _ = []
dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest] dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest]
dropModifier x = [x] dropModifier x = [x]
-- Useful generic functions. -- Useful generic functions.
@ -785,12 +788,12 @@ potentially = fromMaybe (return ())
-- Get element 0 or a default. Like `head` but safe. -- Get element 0 or a default. Like `head` but safe.
headOrDefault _ (a:_) = a headOrDefault _ (a:_) = a
headOrDefault def _ = def headOrDefault def _ = def
--- Get element n of a list, or Nothing. Like `!!` but safe. --- Get element n of a list, or Nothing. Like `!!` but safe.
(!!!) list i = (!!!) list i =
case drop i list of case drop i list of
[] -> Nothing [] -> Nothing
(r:_) -> Just r (r:_) -> Just r
-- Run a command if the shell is in the given list -- Run a command if the shell is in the given list
@ -811,7 +814,7 @@ filterByAnnotation asSpec params =
any hasNum anns any hasNum anns
where where
hasNum (DisableComment ts) = num == ts hasNum (DisableComment ts) = num == ts
hasNum _ = False hasNum _ = False
shouldIgnoreFor _ T_Include {} = not $ asCheckSourced asSpec shouldIgnoreFor _ T_Include {} = not $ asCheckSourced asSpec
shouldIgnoreFor _ _ = False shouldIgnoreFor _ _ = False
parents = parentMap params parents = parentMap params
@ -821,7 +824,7 @@ filterByAnnotation asSpec params =
isCountingReference (T_DollarBraced id token) = isCountingReference (T_DollarBraced id token) =
case concat $ oversimplify token of case concat $ oversimplify token of
'#':_ -> True '#':_ -> True
_ -> False _ -> False
isCountingReference _ = False isCountingReference _ = False
-- FIXME: doesn't handle ${a:+$var} vs ${a:+"$var"} -- FIXME: doesn't handle ${a:+$var} vs ${a:+"$var"}
@ -844,8 +847,8 @@ getOpts string cmd = process flags
where where
flags = getAllFlags cmd flags = getAllFlags cmd
flagList (c:':':rest) = ([c], True) : flagList rest flagList (c:':':rest) = ([c], True) : flagList rest
flagList (c:rest) = ([c], False) : flagList rest flagList (c:rest) = ([c], False) : flagList rest
flagList [] = [] flagList [] = []
flagMap = Map.fromList $ ("", False) : flagList string flagMap = Map.fromList $ ("", False) : flagList string
process [] = return [] process [] = return []