{-# LANGUAGE TemplateHaskell #-}

{-# LANGUAGE NoMonomorphismRestriction #-}

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE MultiWayIf #-}

module ShellCheck.Parser (parseScript, runTests) where

import ShellCheck.AST

import ShellCheck.ASTLib hiding (runTests)

import ShellCheck.Data

import ShellCheck.Interface

import Control.Applicative ((<*), (*>))

import Control.Monad

import Control.Monad.Identity

import Control.Monad.Trans

import Data.Char

import Data.Functor

import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub, find)

import Data.Maybe

import Data.Monoid

import Debug.Trace -- STRIP

import GHC.Exts (sortWith)

import Prelude hiding (readList)

import System.IO

import Text.Parsec hiding (runParser, (<?>))

import Text.Parsec.Error

import Text.Parsec.Pos

import qualified Control.Monad.Reader as Mr

import qualified Control.Monad.State as Ms

import qualified Data.Map as Map

import Test.QuickCheck.All (quickCheckAll)

type SCBase m = Mr.ReaderT (Environment m) (Ms.StateT SystemState m)

type SCParser m v = ParsecT String UserState (SCBase m) v

backslash :: Monad m => SCParser m Char

backslash = char '\\'

linefeed :: Monad m => SCParser m Char

linefeed = do

optional carriageReturn

c <- char '\n'

readPendingHereDocs

return c

singleQuote = char '\''

doubleQuote = char '"'

variableStart = upper <|> lower <|> oneOf "_"

variableChars = upper <|> lower <|> digit <|> oneOf "_"

functionChars = variableChars <|> oneOf ":+?-./^@,"

extendedFunctionChars = functionChars <|> oneOf "[]*=!"

specialVariable = oneOf (concat specialVariables)

paramSubSpecialChars = oneOf "/:+-=%"

quotableChars = "|&;<>()\\ '\t\n\r\xA0" ++ doubleQuotableChars

quotable = almostSpace <|> oneOf quotableChars

bracedQuotable = oneOf "}\"$`'"

doubleQuotableChars = "\\\"$`"

doubleQuotable = oneOf doubleQuotableChars

whitespace = oneOf " \t" <|> carriageReturn <|> almostSpace <|> linefeed

linewhitespace = oneOf " \t" <|> almostSpace

suspectCharAfterQuotes = variableChars <|> char '%'

extglobStartChars = "?*@!+"

extglobStart = oneOf extglobStartChars

unicodeDoubleQuotes = "\x201C\x201D\x2033\x2036"

unicodeSingleQuotes = "\x2018\x2019"

prop_spacing1 = isOk spacing " \\\n # Comment"

prop_spacing2 = isOk spacing "# We can continue lines with \\"

prop_spacing3 = isWarning spacing " \\\n # --verbose=true \\"

spacing = do

x <- many (many1 linewhitespace <|> continuation)

optional readComment

return $ concat x

where

continuation = do

try (string "\\\n")

-- The line was continued. Warn if this next line is a comment with a trailing \

whitespace <- many linewhitespace

optional $ do

x <- readComment

when ("\\" `isSuffixOf` x) $

parseProblem ErrorC 1143 "This backslash is part of a comment and does not continue the line."

return whitespace

spacing1 = do

spacing <- spacing

when (null spacing) $ fail "Expected whitespace"

return spacing

prop_allspacing = isOk allspacing "#foo"

prop_allspacing2 = isOk allspacing " #foo\n # bar\n#baz\n"

prop_allspacing3 = isOk allspacing "#foo\n#bar\n#baz\n"

allspacing = do

s <- spacing

more <- option False (linefeed >> return True)

if more then do

rest <- allspacing

return $ s ++ "\n" ++ rest

else

return s

allspacingOrFail = do

s <- allspacing

when (null s) $ fail "Expected whitespace"

return s

readUnicodeQuote = do

start <- startSpan

c <- oneOf (unicodeSingleQuotes ++ unicodeDoubleQuotes)

id <- endSpan start

parseProblemAtId id WarningC 1110 "This is a unicode quote. Delete and retype it (or quote to make literal)."

return $ T_Literal id [c]

carriageReturn = do

pos <- getPosition

char '\r'

parseProblemAt pos ErrorC 1017 "Literal carriage return. Run script through tr -d '\\r' ."

return '\r'

almostSpace =

choice [

check '\xA0' "unicode non-breaking space",

check '\x200B' "unicode zerowidth space"

]

where

check c name = do

parseNote ErrorC 1018 $ "This is a " ++ name ++ ". Delete and retype it."

char c

return ' '

data ParseNote = ParseNote SourcePos SourcePos Severity Code String deriving (Show, Eq)

data Context =

ContextName SourcePos String

| ContextAnnotation [Annotation]

| ContextSource String

deriving (Show)

data HereDocContext =

HereDocPending Token [Context] -- on linefeed, read this T_HereDoc

deriving (Show)

data UserState = UserState {

lastId :: Id,

positionMap :: Map.Map Id (SourcePos, SourcePos),

parseNotes :: [ParseNote],

hereDocMap :: Map.Map Id [Token],

pendingHereDocs :: [HereDocContext]

initialUserState = UserState {

lastId = Id $ -1,

positionMap = Map.empty,

parseNotes = [],

hereDocMap = Map.empty,

pendingHereDocs = []

}

codeForParseNote (ParseNote _ _ _ code _) = code

getLastId = lastId <$> getState

getNextIdBetween startPos endPos = do

state <- getState

let newId = incId (lastId state)

let newMap = Map.insert newId (startPos, endPos) (positionMap state)

putState $ state {

lastId = newId,

positionMap = newMap

}

return newId

where incId (Id n) = Id $ n+1

getNextIdSpanningTokens startTok endTok = do

(start, _) <- getSpanForId (getId startTok)

(_, end) <- getSpanForId (getId endTok)

getNextIdBetween start end

getNextIdSpanningTokenList list =

case list of

[] -> do

pos <- getPosition

getNextIdBetween pos pos

(h:_) ->

getNextIdSpanningTokens h (last list)

getSpanForId :: Monad m => Id -> SCParser m (SourcePos, SourcePos)

getSpanForId id =

Map.findWithDefault (error "Internal error: no position for id. Please report!") id <$>

getMap

getNewIdFor :: Monad m => Id -> SCParser m Id

getNewIdFor id = getSpanForId id >>= uncurry getNextIdBetween

data IncompleteInterval = IncompleteInterval SourcePos

startSpan = IncompleteInterval <$> getPosition

endSpan (IncompleteInterval start) = do

endPos <- getPosition

getNextIdBetween start endPos

getSpanPositionsFor m = do

start <- getPosition

m

end <- getPosition

return (start, end)

addToHereDocMap id list = do

state <- getState

let map = hereDocMap state

putState $ state {

hereDocMap = Map.insert id list map

}

addPendingHereDoc t = do

state <- getState

context <- getCurrentContexts

let docs = pendingHereDocs state

putState $ state {

pendingHereDocs = HereDocPending t context : docs

}

popPendingHereDocs = do

state <- getState

let pending = pendingHereDocs state

putState $ state {

pendingHereDocs = []

}

return . reverse $ pendingHereDocs state

getMap = positionMap <$> getState

getParseNotes = parseNotes <$> getState

addParseNote n = do

irrelevant <- shouldIgnoreCode (codeForParseNote n)

unless irrelevant $ do

state <- getState

putState $ state {

parseNotes = n : parseNotes state

}

ignoreProblemsOf p = do

systemState <- lift . lift $ Ms.get

p <* (lift . lift . Ms.put $ systemState)

shouldIgnoreCode code = do

context <- getCurrentContexts

checkSourced <- Mr.asks checkSourced

return $ any (contextItemDisablesCode checkSourced code) context

contextItemDisablesCode :: Bool -> Integer -> Context -> Bool

contextItemDisablesCode alsoCheckSourced code = disabling alsoCheckSourced

where

disabling checkSourced item =

case item of

ContextAnnotation list -> any disabling' list

ContextSource _ -> not $ checkSourced

_ -> False

disabling' (DisableComment n m) = code >= n && code < m

disabling' _ = False

getCurrentAnnotations includeSource =

concatMap get . takeWhile (not . isBoundary) <$> getCurrentContexts

where

get (ContextAnnotation list) = list

get _ = []

isBoundary (ContextSource _) = not includeSource

isBoundary _ = False

shouldFollow file = do

context <- getCurrentContexts

if any isThisFile context

then return False

else

if length (filter isSource context) >= 100

then do

parseProblem ErrorC 1092 "Stopping at 100 'source' frames :O"

return False

else

return True

where

isSource (ContextSource _) = True

isSource _ = False

isThisFile (ContextSource name) | name == file = True

isThisFile _= False

getSourceOverride = do

context <- getCurrentContexts

return . msum . map findFile $ takeWhile isSameFile context

where

isSameFile (ContextSource _) = False

isSameFile _ = True

findFile (ContextAnnotation list) = msum $ map getFile list

findFile _ = Nothing

getFile (SourceOverride str) = Just str

getFile _ = Nothing

data SystemState = SystemState {

contextStack :: [Context],

parseProblems :: [ParseNote]

initialSystemState = SystemState {

contextStack = [],

parseProblems = []

}

data Environment m = Environment {

systemInterface :: SystemInterface m,

checkSourced :: Bool,

ignoreRC :: Bool,

currentFilename :: String,

shellTypeOverride :: Maybe Shell

parseProblem level code msg = do

pos <- getPosition

parseProblemAt pos level code msg

setCurrentContexts c = Ms.modify (\state -> state { contextStack = c })

getCurrentContexts = Ms.gets contextStack

popContext = do

v <- getCurrentContexts

case v of

(a:r) -> do

setCurrentContexts r

return $ Just a

[] ->

return Nothing

pushContext c = do

v <- getCurrentContexts

setCurrentContexts (c:v)

parseProblemAtWithEnd start end level code msg = do

irrelevant <- shouldIgnoreCode code

unless irrelevant $

addParseProblem note

where

note = ParseNote start end level code msg

addParseProblem note =

Ms.modify (\state -> state {

parseProblems = note:parseProblems state

})

parseProblemAt pos = parseProblemAtWithEnd pos pos

parseProblemAtId :: Monad m => Id -> Severity -> Integer -> String -> SCParser m ()

parseProblemAtId id level code msg = do

(start, end) <- getSpanForId id

parseProblemAtWithEnd start end level code msg

parseNote c l a = do

pos <- getPosition

parseNoteAt pos c l a

parseNoteAt pos c l a = addParseNote $ ParseNote pos pos c l a

parseNoteAtId id c l a = do

(start, end) <- getSpanForId id

addParseNote $ ParseNote start end c l a

parseNoteAtWithEnd start end c l a = addParseNote $ ParseNote start end c l a

thenSkip main follow = main <* optional follow

unexpecting s p = try $

(try p >> fail ("Unexpected " ++ s)) <|> return ()

notFollowedBy2 = unexpecting ""

isFollowedBy p = (lookAhead . try $ p $> True) <|> return False

reluctantlyTill p end =

(lookAhead (void (try end) <|> eof) >> return []) <|> do

x <- p

more <- reluctantlyTill p end

return $ x:more

<|> return []

reluctantlyTill1 p end = do

notFollowedBy2 end

x <- p

more <- reluctantlyTill p end

return $ x:more

attempting rest branch =

(try branch >> rest) <|> rest

orFail parser errorAction =

try parser <|> (errorAction >>= fail)

withParser node parser = do

start <- startSpan

contents <- parser

id <- endSpan start

return $ node id contents

wasIncluded p = option False (p >> return True)

acceptButWarn parser level code note =

optional $ try (do

pos <- getPosition

parser

parseProblemAt pos level code note

)

parsecBracket before after op = do

val <- before

op val `thenSkip` after val <|> (after val *> fail "")

swapContext contexts p =

parsecBracket (getCurrentContexts <* setCurrentContexts contexts)

setCurrentContexts

(const p)

withContext entry p = parsecBracket (pushContext entry) (const popContext) (const p)

called s p = do

pos <- getPosition

withContext (ContextName pos s) p

withAnnotations anns =

withContext (ContextAnnotation anns)

readConditionContents single =

readCondContents `attempting` lookAhead (do

pos <- getPosition

s <- readVariableName

spacing1

when (s `elem` commonCommands) $

parseProblemAt pos WarningC 1014 "Use 'if cmd; then ..' to check exit code, or 'if [[ $(cmd) == .. ]]' to check output.")

where

spacingOrLf = condSpacing True

condSpacing required = do

pos <- getPosition

space <- allspacing

when (required && null space) $

parseProblemAt pos ErrorC 1035 "You are missing a required space here."

when (single && '\n' `elem` space) $

parseProblemAt pos ErrorC 1080 "When breaking lines in [ ], you need \\ before the linefeed."

return space

typ = if single then SingleBracket else DoubleBracket

readCondBinaryOp = try $ do

optional guardArithmetic

op <- getOp

spacingOrLf

return op

where

flaglessOps = [ "==", "!=", "<=", ">=", "=~", ">", "<", "=" ]

getOp = do

start <- startSpan

op <- readRegularOrEscaped anyOp

id <- endSpan start

return $ TC_Binary id typ op

anyOp = flagOp <|> flaglessOp <|> fail

"Expected comparison operator (don't wrap commands in []/[[]])"

flagOp = try $ do

s <- readOp

when (s == "-a" || s == "-o") $ fail "Unexpected operator"

return s

flaglessOp =

choice $ map (try . string) flaglessOps

-- hacks to read quoted operators without having to read a shell word

readEscaped p = try $ withEscape <|> withQuotes

where

withEscape = do

char '\\'

escaped <$> p

withQuotes = do

c <- oneOf "'\""

s <- p

char c

return $ escaped s

escaped s = if any (`elem` s) "<>()" then '\\':s else s

readRegularOrEscaped p = readEscaped p <|> p

guardArithmetic = do

try . lookAhead $ void (oneOf "+*/%") <|> void (string "- ")

parseProblem ErrorC 1076 $

if single

then "Trying to do math? Use e.g. [ $((i/2+7)) -ge 18 ]."

else "Trying to do math? Use e.g. [[ $((i/2+7)) -ge 18 ]]."

readCondUnaryExp = do

op <- readCondUnaryOp

pos <- getPosition

liftM op readCondWord `orFail` do

parseProblemAt pos ErrorC 1019 "Expected this to be an argument to the unary condition."

return "Expected an argument for the unary operator"

readCondUnaryOp = try $ do

start <- startSpan

s <- readOp

id <- endSpan start

spacingOrLf

return $ TC_Unary id typ s

readOp = try $ do

char '-' <|> weirdDash

s <- many1 letter <|> fail "Expected a test operator"

return ('-':s)

weirdDash = do

pos <- getPosition

oneOf "\x058A\x05BE\x2010\x2011\x2012\x2013\x2014\x2015\xFE63\xFF0D"

parseProblemAt pos ErrorC 1100

"This is a unicode dash. Delete and retype as ASCII minus."

return '-'

readCondWord = do

notFollowedBy2 (try (spacing >> string "]"))

x <- readNormalWord

pos <- getPosition

when (notArrayIndex x && endedWith "]" x && not (x `containsLiteral` "[")) $ do

parseProblemAt pos ErrorC 1020 $

"You need a space before the " ++ (if single then "]" else "]]") ++ "."

fail "Missing space before ]"

when (single && endedWith ")" x) $ do

parseProblemAt pos ErrorC 1021

"You need a space before the \\)"

fail "Missing space before )"

void spacing

return x

where endedWith str (T_NormalWord id s@(_:_)) =

case last s of T_Literal id s -> str `isSuffixOf` s

_ -> False

endedWith _ _ = False

notArrayIndex (T_NormalWord id s@(_:T_Literal _ t:_)) = t /= "["

notArrayIndex _ = True

containsLiteral x s = s `isInfixOf` onlyLiteralString x

readCondAndOp = readAndOrOp TC_And "&&" False <|> readAndOrOp TC_And "-a" True

readCondOrOp = do

optional guardArithmetic

readAndOrOp TC_Or "||" False <|> readAndOrOp TC_Or "-o" True

readAndOrOp node op requiresSpacing = do

optional $ lookAhead weirdDash

start <- startSpan

x <- try $ string op

id <- endSpan start

condSpacing requiresSpacing

return $ node id typ x

readCondNullaryOrBinary = do

start <- startSpan

x <- readCondWord `attempting` (do

pos <- getPosition

lookAhead (char '[')

parseProblemAt pos ErrorC 1026 $ if single

then "If grouping expressions inside [..], use \\( ..\\)."

else "If grouping expressions inside [[..]], use ( .. )."

)

id <- endSpan start

(do

pos <- getPosition

isRegex <- regexOperatorAhead

op <- readCondBinaryOp

y <- if isRegex

then readRegex

else readCondWord <|> (parseProblemAt pos ErrorC 1027 "Expected another argument for this operator." >> mzero)

return (x `op` y)

) <|> ( do

checkTrailingOp x

return $ TC_Nullary id typ x

)

checkTrailingOp x = sequence_ $ do

(T_Literal id str) <- getTrailingUnquotedLiteral x

trailingOp <- find (`isSuffixOf` str) binaryTestOps

return $ parseProblemAtId id ErrorC 1108 $

"You need a space before and after the " ++ trailingOp ++ " ."

readCondGroup = do

start <- startSpan

pos <- getPosition

lparen <- try $ readRegularOrEscaped (string "(")

when (single && lparen == "(") $

singleWarning pos

when (not single && lparen == "\\(") $

doubleWarning pos

condSpacing single

x <- readCondContents

cpos <- getPosition

rparen <- readRegularOrEscaped (string ")")

id <- endSpan start

condSpacing single

when (single && rparen == ")") $

singleWarning cpos

when (not single && rparen == "\\)") $

doubleWarning cpos

return $ TC_Group id typ x

where

singleWarning pos =

parseProblemAt pos ErrorC 1028 "In [..] you have to escape \\( \\) or preferably combine [..] expressions."

doubleWarning pos =

parseProblemAt pos ErrorC 1029 "In [[..]] you shouldn't escape ( or )."

-- Currently a bit of a hack since parsing rules are obscure

regexOperatorAhead = lookAhead (do

try (string "=~") <|> try (string "~=")

return True)

<|> return False

readRegex = called "regex" $ do

start <- startSpan

parts <- many1 readPart

id <- endSpan start

void spacing

return $ T_NormalWord id parts

where

readPart = choice [

readGroup,

readSingleQuoted,

readDoubleQuoted,

readDollarExpression,

readLiteralForParser $ readNormalLiteral "( ",

readLiteralString "|",

readGlobLiteral

]

readGlobLiteral = do

start <- startSpan

s <- extglobStart <|> oneOf "{}[]$"

id <- endSpan start

return $ T_Literal id [s]

readGroup = called "regex grouping" $ do

start <- startSpan

p1 <- readLiteralString "("

parts <- many (readPart <|> readRegexLiteral)

p2 <- readLiteralString ")"

id <- endSpan start

return $ T_NormalWord id (p1:(parts ++ [p2]))

readRegexLiteral = do

start <- startSpan

str <- readGenericLiteral1 (singleQuote <|> doubleQuotable <|> oneOf "()")

id <- endSpan start

return $ T_Literal id str

readLiteralString s = do

start <- startSpan

str <- string s

id <- endSpan start

return $ T_Literal id str

readCondTerm = do

term <- readCondNot <|> readCondExpr

condSpacing False

return term

readCondNot = do

start <- startSpan

char '!'

id <- endSpan start

spacingOrLf

expr <- readCondExpr

return $ TC_Unary id typ "!" expr

readCondExpr =

readCondGroup <|> readCondUnaryExp <|> readCondNullaryOrBinary

readCondOr = chainl1 readCondAnd readCondAndOp

readCondAnd = chainl1 readCondTerm readCondOrOp

readCondContents = readCondOr

prop_a1 = isOk readArithmeticContents " n++ + ++c"

prop_a2 = isOk readArithmeticContents "$N*4-(3,2)"

prop_a3 = isOk readArithmeticContents "n|=2<<1"

prop_a4 = isOk readArithmeticContents "n &= 2 **3"

prop_a5 = isOk readArithmeticContents "1 |= 4 && n >>= 4"

prop_a6 = isOk readArithmeticContents " 1 | 2 ||3|4"

prop_a7 = isOk readArithmeticContents "3*2**10"

prop_a8 = isOk readArithmeticContents "3"

prop_a9 = isOk readArithmeticContents "a^!-b"

prop_a10= isOk readArithmeticContents "! $?"

prop_a11= isOk readArithmeticContents "10#08 * 16#f"

prop_a12= isOk readArithmeticContents "\"$((3+2))\" + '37'"

prop_a13= isOk readArithmeticContents "foo[9*y+x]++"

prop_a14= isOk readArithmeticContents "1+`echo 2`"

prop_a15= isOk readArithmeticContents "foo[`echo foo | sed s/foo/4/g` * 3] + 4"

prop_a16= isOk readArithmeticContents "$foo$bar"

prop_a17= isOk readArithmeticContents "i<(0+(1+1))"

prop_a18= isOk readArithmeticContents "a?b:c"

prop_a19= isOk readArithmeticContents "\\\n3 +\\\n 2"

prop_a20= isOk readArithmeticContents "a ? b ? c : d : e"

prop_a21= isOk readArithmeticContents "a ? b : c ? d : e"

prop_a22= isOk readArithmeticContents "!!a"

prop_a23= isOk readArithmeticContents "~0"

readArithmeticContents :: Monad m => SCParser m Token

readArithmeticContents =

readSequence

where

spacing =

let lf = try (string "\\\n") >> return '\n'

in many (whitespace <|> lf)

splitBy x ops = chainl1 x (readBinary ops)

readBinary ops = readComboOp ops TA_Binary

readComboOp op token = do

start <- startSpan

op <- choice (map (\x -> try $ do

s <- string x

failIfIncompleteOp

return s

) op)

id <- endSpan start

spacing

return $ token id op

failIfIncompleteOp = notFollowedBy2 $ oneOf "&|<>="

-- Read binary minus, but also check for -lt, -gt and friends:

readMinusOp = do

start <- startSpan

pos <- getPosition

try $ do

char '-'

failIfIncompleteOp

optional $ do

(str, alt) <- lookAhead . choice $ map tryOp [

("lt", "<"),

("gt", ">"),

("le", "<="),

("ge", ">="),

("eq", "=="),

("ne", "!=")

]

parseProblemAt pos ErrorC 1106 $ "In arithmetic contexts, use " ++ alt ++ " instead of -" ++ str

id <- endSpan start

spacing

return $ TA_Binary id "-"

where

tryOp (str, alt) = try $ do

string str

spacing1

return (str, alt)

readArrayIndex = do

start <- startSpan

char '['

pos <- getPosition

middle <- readStringForParser readArithmeticContents

char ']'

id <- endSpan start

return $ T_UnparsedIndex id pos middle

literal s = do

start <- startSpan

string s

id <- endSpan start

return $ T_Literal id s

readVariable = do

start <- startSpan

name <- readVariableName

indices <- many readArrayIndex

id <- endSpan start

spacing

return $ TA_Variable id name indices

readExpansion = do

start <- startSpan

pieces <- many1 $ choice [

readSingleQuoted,

readDoubleQuoted,

readNormalDollar,

readBraced,

readUnquotedBackTicked,

literal "#",

readNormalLiteral "+-*/=%^,]?:"

]

id <- endSpan start

spacing

return $ TA_Expansion id pieces

readGroup = do

char '('

s <- readSequence

char ')'

spacing

return s

readArithTerm = readGroup <|> readVariable <|> readExpansion

readSequence = do

spacing

start <- startSpan

l <- readAssignment `sepBy` (char ',' >> spacing)

id <- endSpan start

return $ TA_Sequence id l

readAssignment = chainr1 readTrinary readAssignmentOp

readAssignmentOp = readComboOp ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="] TA_Assignment

readTrinary = do

x <- readLogicalOr

do

start <- startSpan

string "?"

spacing

y <- readTrinary

string ":"

spacing

z <- readTrinary

id <- endSpan start

return $ TA_Trinary id x y z

<|>

return x

readLogicalOr = readLogicalAnd `splitBy` ["||"]

readLogicalAnd = readBitOr `splitBy` ["&&"]

readBitOr = readBitXor `splitBy` ["|"]

readBitXor = readBitAnd `splitBy` ["^"]

readBitAnd = readEquated `splitBy` ["&"]

readEquated = readCompared `splitBy` ["==", "!="]

readCompared = readShift `splitBy` ["<=", ">=", "<", ">"]

readShift = readAddition `splitBy` ["<<", ">>"]

readAddition = chainl1 readMultiplication (readBinary ["+"] <|> readMinusOp)

readMultiplication = readExponential `splitBy` ["*", "/", "%"]

readExponential = readAnyNegated `splitBy` ["**"]

readAnyNegated = readNegated <|> readAnySigned

readNegated = do

start <- startSpan

op <- oneOf "!~"

id <- endSpan start

spacing

x <- readAnyNegated

return $ TA_Unary id [op] x

readAnySigned = readSigned <|> readAnycremented

readSigned = do

start <- startSpan

op <- choice (map readSignOp "+-")

id <- endSpan start

spacing

x <- readAnycremented

return $ TA_Unary id [op] x

where

readSignOp c = try $ do

char c

notFollowedBy2 $ char c

spacing

return c

readAnycremented = readNormalOrPostfixIncremented <|> readPrefixIncremented

readPrefixIncremented = do

start <- startSpan

op <- try $ string "++" <|> string "--"

id <- endSpan start

spacing

x <- readArithTerm

return $ TA_Unary id (op ++ "|") x

readNormalOrPostfixIncremented = do

x <- readArithTerm

spacing

do

start <- startSpan

op <- try $ string "++" <|> string "--"

id <- endSpan start

spacing

return $ TA_Unary id ('|':op) x

<|>

return x

prop_readCondition = isOk readCondition "[ \\( a = b \\) -a \\( c = d \\) ]"

prop_readCondition2 = isOk readCondition "[[ (a = b) || (c = d) ]]"

prop_readCondition3 = isOk readCondition "[[ $c = [[:alpha:].~-] ]]"

prop_readCondition4 = isOk readCondition "[[ $c =~ *foo* ]]"

prop_readCondition5 = isOk readCondition "[[ $c =~ f( ]] )* ]]"

prop_readCondition5a = isOk readCondition "[[ $c =~ a(b) ]]"

prop_readCondition5b = isOk readCondition "[[ $c =~ f( ($var ]]) )* ]]"

prop_readCondition6 = isOk readCondition "[[ $c =~ ^[yY]$ ]]"

prop_readCondition7 = isOk readCondition "[[ ${line} =~ ^[[:space:]]*# ]]"

prop_readCondition8 = isOk readCondition "[[ $l =~ ogg|flac ]]"

prop_readCondition9 = isOk readCondition "[ foo -a -f bar ]"

prop_readCondition10 = isOk readCondition "[[\na == b\n||\nc == d ]]"

prop_readCondition10a= isOk readCondition "[[\na == b ||\nc == d ]]"

prop_readCondition10b= isOk readCondition "[[ a == b\n||\nc == d ]]"

prop_readCondition11 = isOk readCondition "[[ a == b ||\n c == d ]]"

prop_readCondition12 = isWarning readCondition "[ a == b \n -o c == d ]"

prop_readCondition13 = isOk readCondition "[[ foo =~ ^fo{1,3}$ ]]"

prop_readCondition14 = isOk readCondition "[ foo '>' bar ]"

prop_readCondition15 = isOk readCondition "[ foo \">=\" bar ]"

prop_readCondition16 = isOk readCondition "[ foo \\< bar ]"

prop_readCondition17 = isOk readCondition "[[ ${file::1} = [-.\\|/\\\\] ]]"

prop_readCondition18 = isOk readCondition "[ ]"

prop_readCondition19 = isOk readCondition "[ '(' x \")\" ]"

prop_readCondition20 = isOk readCondition "[[ echo_rc -eq 0 ]]"

prop_readCondition21 = isOk readCondition "[[ $1 =~ ^(a\\ b)$ ]]"

prop_readCondition22 = isOk readCondition "[[ $1 =~ \\.a\\.(\\.b\\.)\\.c\\. ]]"

prop_readCondition23 = isOk readCondition "[[ -v arr[$var] ]]"

prop_readCondition25 = isOk readCondition "[[ lex.yy.c -ot program.l ]]"

prop_readCondition26 = isOk readScript "[[ foo ]]\\\n && bar"

prop_readCondition27 = not $ isOk readConditionCommand "[[ x ]] foo"

prop_readCondition28 = isOk readCondition "[[ x = [\"$1\"] ]]"

prop_readCondition29 = isOk readCondition "[[ x = [*] ]]"

readCondition = called "test expression" $ do

opos <- getPosition

start <- startSpan

open <- try (string "[[") <|> string "["

let single = open == "["

let typ = if single then SingleBracket else DoubleBracket

pos <- getPosition

space <- allspacing

when (null space) $

parseProblemAtWithEnd opos pos ErrorC 1035 $ "You need a space after the " ++

if single

then "[ and before the ]."

else "[[ and before the ]]."

when (single && '\n' `elem` space) $

parseProblemAt pos ErrorC 1080 "You need \\ before line feeds to break lines in [ ]."

condition <- readConditionContents single <|> do

guard . not . null $ space

lookAhead $ string "]"

id <- endSpan start

return $ TC_Empty id typ

cpos <- getPosition

close <- try (string "]]") <|> string "]" <|> fail "Expected test to end here (don't wrap commands in []/[[]])"

id <- endSpan start

when (open == "[[" && close /= "]]") $ parseProblemAt cpos ErrorC 1033 "Test expression was opened with double [[ but closed with single ]. Make sure they match."

when (open == "[" && close /= "]" ) $ parseProblemAt opos ErrorC 1034 "Test expression was opened with single [ but closed with double ]]. Make sure they match."

spacing

return $ T_Condition id typ condition

readAnnotationPrefix = do

char '#'

many linewhitespace

string "shellcheck"

prop_readAnnotation1 = isOk readAnnotation "# shellcheck disable=1234,5678\n"

prop_readAnnotation2 = isOk readAnnotation "# shellcheck disable=SC1234 disable=SC5678\n"

prop_readAnnotation3 = isOk readAnnotation "# shellcheck disable=SC1234 source=/dev/null disable=SC5678\n"

prop_readAnnotation4 = isWarning readAnnotation "# shellcheck cats=dogs disable=SC1234\n"

prop_readAnnotation5 = isOk readAnnotation "# shellcheck disable=SC2002 # All cats are precious\n"

prop_readAnnotation6 = isOk readAnnotation "# shellcheck disable=SC1234 # shellcheck foo=bar\n"

prop_readAnnotation7 = isOk readAnnotation "# shellcheck disable=SC1000,SC2000-SC3000,SC1001\n"

prop_readAnnotation8 = isOk readAnnotation "# shellcheck disable=all\n"

readAnnotation = called "shellcheck directive" $ do

try readAnnotationPrefix

many1 linewhitespace

readAnnotationWithoutPrefix True

readAnnotationWithoutPrefix sandboxed = do

values <- many1 readKey

optional readAnyComment

void linefeed <|> eof <|> do