{-# LANGUAGE NoMonomorphismRestriction, TemplateHaskell, FlexibleContexts #-}

module ShellCheck.Parser (parseScript, runTests) where

import ShellCheck.AST

import ShellCheck.ASTLib

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)

import Data.Maybe

import Data.Monoid

import Debug.Trace

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 (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 :: Monad m => SCParser m Char

linefeed = do

optional carriageReturn

c <- char '\n'

readPendingHereDocs

return c

singleQuote = char '\'' <|> unicodeSingleQuote

doubleQuote = char '"' <|> unicodeDoubleQuote

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

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

functionChars = variableChars <|> oneOf ":+-.?"

specialVariable = oneOf "@*#?-$!"

paramSubSpecialChars = oneOf "/:+-=%"

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

quotable = almostSpace <|> unicodeDoubleQuote <|> oneOf quotableChars

bracedQuotable = oneOf "}\"$`'"

doubleQuotableChars = "\"$`" ++ unicodeDoubleQuoteChars

doubleQuotable = unicodeDoubleQuote <|> oneOf doubleQuotableChars

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

linewhitespace = oneOf " \t" <|> almostSpace

suspectCharAfterQuotes = variableChars <|> char '%'

extglobStartChars = "?*@!+"

extglobStart = oneOf extglobStartChars

unicodeDoubleQuoteChars = "\x201C\x201D\x2033\x2036"

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

spacing = do

x <- many (many1 linewhitespace <|> try (string "\\\n" >> return ""))

optional readComment

return $ concat x

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"

unicodeDoubleQuote = do

pos <- getPosition

oneOf unicodeDoubleQuoteChars

parseProblemAt pos WarningC 1015 "This is a unicode double quote. Delete and retype it."

return '"'

unicodeSingleQuote = do

pos <- getPosition

char '\x2018' <|> char '\x2019'

parseProblemAt pos WarningC 1016 "This is a unicode single quote. Delete and retype it."

return '"'

carriageReturn = do

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

char '\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 Note = Note Id Severity Code String deriving (Show, Eq)

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 -- on linefeed, read this T_HereDoc

| HereDocBoundary -- but don't consider heredocs before this

deriving (Show)

data UserState = UserState {

lastId :: Id,

positionMap :: Map.Map Id 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

noteToParseNote map (Note id severity code message) =

ParseNote pos pos severity code message

where

pos = fromJust $ Map.lookup id map

getLastId = lastId <$> getState

getNextIdAt sourcepos = do

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

getNextId :: Monad m => SCParser m Id

getNextId = do

pos <- getPosition

getNextIdAt pos

addToHereDocMap id list = do

state <- getState

let map = hereDocMap state

putState $ state {

hereDocMap = Map.insert id list map

}

withHereDocBoundary p = do

pushBoundary

do

v <- p

popBoundary

return v

<|> do

popBoundary

fail ""

where

pushBoundary = do

state <- getState

let docs = pendingHereDocs state

putState $ state {

pendingHereDocs = HereDocBoundary : docs

}

popBoundary = do

state <- getState

let docs = tail $ dropWhile (not . isHereDocBoundary) $

pendingHereDocs state

putState $ state {

pendingHereDocs = docs

}

addPendingHereDoc t = do

state <- getState

let docs = pendingHereDocs state

putState $ state {

pendingHereDocs = HereDocPending t : docs

}

popPendingHereDocs = do

state <- getState

let (pending, boundary) = break isHereDocBoundary $ pendingHereDocs state

putState $ state {

pendingHereDocs = boundary

}

return . map extract . reverse $ pendingHereDocs state

where

extract (HereDocPending t) = t

isHereDocBoundary x = case x of

HereDocBoundary -> True

otherwise -> False

getMap = positionMap <$> getState

getParseNotes = parseNotes <$> getState

addParseNote n = do

irrelevant <- shouldIgnoreCode (codeForParseNote n)

unless irrelevant $ do

state <- getState

putState $ state {

parseNotes = n : parseNotes state

}

shouldIgnoreCode code = do

context <- getCurrentContexts

return $ any disabling context

where

disabling (ContextAnnotation list) =

any disabling' list

disabling (ContextSource _) = True -- Don't add messages for sourced files

disabling _ = False

disabling' (DisableComment n) = code == n

disabling' _ = 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 = []

}

parseProblem level code msg = do

pos <- getPosition

parseProblemAt pos level code msg

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

getCurrentContexts = contextStack <$> Ms.get

popContext = do

v <- getCurrentContexts

if not $ null v

then do

let (a:r) = v

setCurrentContexts r

return $ Just a

else

return Nothing

pushContext c = do

v <- getCurrentContexts

setCurrentContexts (c:v)

parseProblemAtWithEnd start end level code msg = do

irrelevant <- shouldIgnoreCode code

unless irrelevant $

Ms.modify (\state -> state {

parseProblems = note:parseProblems state

})

where

note = ParseNote start end level code msg

parseProblemAt pos = parseProblemAtWithEnd pos pos

parseNote c l a = do

pos <- getPosition

parseNoteAt pos c l a

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

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

thenSkip main follow = do

r <- main

optional follow

return r

unexpecting s p = try $

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

notFollowedBy2 = unexpecting ""

disregard = void

reluctantlyTill p end =

(lookAhead (disregard (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

id <- getNextId

contents <- parser

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

)

withContext entry p = do

pushContext entry

do

v <- p

popContext

return v

<|> do -- p failed without consuming input, abort context

v <- popContext

fail ""

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 <- many1 letter

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

id <- getNextId

op <- getOp

spacingOrLf

return op

where

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

getOp = do

id <- getNextId

op <- anyQuotedOp <|> anyEscapedOp <|> anyOp

return $ TC_Binary id typ op

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

anyEscapedOp = try $ do

char '\\'

escaped <$> anyOp

anyQuotedOp = try $ do

c <- oneOf "'\""

s <- anyOp

char c

return $ escaped s

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

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

guardArithmetic = do

try . lookAhead $ disregard (oneOf "+*/%") <|> disregard (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

id <- getNextId

s <- readOp

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 (endedWith "]" x) $ 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 )"

disregard spacing

return x

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

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

_ -> False

endedWith _ _ = False

readCondAndOp = do

id <- getNextId

x <- try (readAndOrOp "&&" False <|> readAndOrOp "-a" True)

return $ TC_And id typ x

readCondOrOp = do

optional guardArithmetic

id <- getNextId

x <- try (readAndOrOp "||" False <|> readAndOrOp "-o" True)

return $ TC_Or id typ x

readAndOrOp op requiresSpacing = do

optional $ lookAhead weirdDash

x <- string op

condSpacing requiresSpacing

return x

readCondNoaryOrBinary = do

id <- getNextId

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 ( .. )."

)

(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)

) <|> return (TC_Noary id typ x)

readCondGroup = do

id <- getNextId

pos <- getPosition

lparen <- try $ string "(" <|> string "\\("

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

parseProblemAt pos ErrorC 1028 "In [..] you have to escape (). Use [[..]] instead."

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

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

condSpacing single

x <- readCondContents

cpos <- getPosition

rparen <- string ")" <|> string "\\)"

condSpacing single

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

parseProblemAt cpos ErrorC 1030 "In [..] you have to escape (). Use [[..]] instead."

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

parseProblemAt cpos ErrorC 1031 "In [[..]] you shouldn't escape ()."

when (isEscaped lparen `xor` isEscaped rparen) $

parseProblemAt pos ErrorC 1032 "Did you just escape one half of () but not the other?"

return $ TC_Group id typ x

where

isEscaped ('\\':_) = True

isEscaped _ = False

xor x y = x && not y || not x && y

-- 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

id <- getNextId

parts <- many1 (

readGroup <|>

readSingleQuoted <|>

readDoubleQuoted <|>

readDollarExpression <|>

readNormalLiteral "( " <|>

readPipeLiteral <|>

readGlobLiteral)

disregard spacing

return $ T_NormalWord id parts

where

readGlobLiteral = do

id <- getNextId

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

return $ T_Literal id [s]

readGroup = called "regex grouping" $ do

id <- getNextId

char '('

parts <- many (readGroup <|> readSingleQuoted <|> readDoubleQuoted <|> readDollarExpression <|> readRegexLiteral <|> readGlobLiteral)

char ')'

return $ T_NormalWord id parts

readRegexLiteral = do

id <- getNextId

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

return $ T_Literal id str

readPipeLiteral = do

id <- getNextId

str <- string "|"

return $ T_Literal id str

readCondTerm = do

term <- readCondNot <|> readCondExpr

condSpacing False

return term

readCondNot = do

id <- getNextId

char '!'

spacingOrLf

expr <- readCondExpr

return $ TC_Unary id typ "!" expr

readCondExpr =

readCondGroup <|> readCondUnaryExp <|> readCondNoaryOrBinary

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"

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

id <- getNextId

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

s <- string x

failIfIncompleteOp

return s

) op)

spacing

return $ token id op

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

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

readMinusOp = do

id <- getNextId

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

spacing

return $ TA_Binary id "-"

where

tryOp (str, alt) = try $ do

string str

spacing1

return (str, alt)

readArrayIndex = do

id <- getNextId

char '['

middle <- readArithmeticContents

char ']'

return $ TA_Index id middle

literal s = do

id <- getNextId

string s

return $ T_Literal id s

readArithmeticLiteral =

readArrayIndex <|> literal "#"

readExpansion = do

id <- getNextId

pieces <- many1 $ choice [

readArithmeticLiteral,

readSingleQuoted,

readDoubleQuoted,

readNormalDollar,

readBraced,

readUnquotedBackTicked,

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

]

spacing

return $ TA_Expansion id pieces

readGroup = do

char '('

s <- readSequence

char ')'

spacing

return s

readArithTerm = readGroup <|> readExpansion

readSequence = do

spacing

id <- getNextId

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

return $ TA_Sequence id l

readAssignment = chainr1 readTrinary readAssignmentOp

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

readTrinary = do

x <- readLogicalOr

do

id <- getNextId

string "?"

spacing

y <- readTrinary

string ":"

spacing

z <- readTrinary

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

id <- getNextId

op <- oneOf "!~"

spacing

x <- readAnyNegated

return $ TA_Unary id [op] x

readAnySigned = readSigned <|> readAnycremented

readSigned = do

id <- getNextId

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

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

id <- getNextId

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

spacing

x <- readArithTerm

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

readNormalOrPostfixIncremented = do

x <- readArithTerm

spacing

do

id <- getNextId

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

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} = [-.\\|/\\\\] ]]"

readCondition = called "test expression" $ do

opos <- getPosition

id <- getNextId

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

let single = open == "["

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

cpos <- getPosition

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

when (open == "[[" && close /= "]]") $ parseProblemAt cpos ErrorC 1033 "Did you mean ]] ?"

when (open == "[" && close /= "]" ) $ parseProblemAt opos ErrorC 1034 "Did you mean [[ ?"

spacing

many readCmdWord -- Read and throw away remainders to get then/do warnings. Fixme?

return $ T_Condition id (if single then SingleBracket else DoubleBracket) 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"

readAnnotation = called "shellcheck annotation" $ do

try readAnnotationPrefix

many1 linewhitespace

values <- many1 (readDisable <|> readSourceOverride <|> readShellOverride <|> anyKey)

linefeed

many linewhitespace

return $ concat values

where

readDisable = forKey "disable" $

readCode `sepBy` char ','

where

readCode = do

optional $ string "SC"

int <- many1 digit

return $ DisableComment (read int)

readSourceOverride = forKey "source" $ do

filename <- many1 $ noneOf " \n"

return [SourceOverride filename]

readShellOverride = forKey "shell" $ do

pos <- getPosition

shell <- many1 $ noneOf " \n"

when (isNothing $ shellForExecutable shell) $

parseNoteAt pos ErrorC 1103

"This shell type is unknown. Use e.g. sh or bash."

return [ShellOverride shell]

forKey s p = do

try $ string s

char '='

value <- p

many linewhitespace

return value

anyKey = do

pos <- getPosition

anyChar `reluctantlyTill1` whitespace

many linewhitespace

parseNoteAt pos WarningC 1107 "This directive is unknown. It will be ignored."

return []

readAnnotations = do

annotations <- many (readAnnotation `thenSkip` allspacing)

return $ concat annotations

readComment = do

unexpecting "shellcheck annotation" readAnnotationPrefix

char '#'

many $ noneOf "\r\n"

prop_readNormalWord = isOk readNormalWord "'foo'\"bar\"{1..3}baz$(lol)"

prop_readNormalWord2 = isOk readNormalWord "foo**(foo)!!!(@@(bar))"

prop_readNormalWord3 = isOk readNormalWord "foo#"

prop_readNormalWord4 = isOk readNormalWord "$\"foo\"$'foo\nbar'"

prop_readNormalWord5 = isWarning readNormalWord "${foo}}"

prop_readNormalWord6 = isOk readNormalWord "foo/{}"

prop_readNormalWord7 = isOk readNormalWord "foo\\\nbar"

prop_readNormalWord8 = isWarning readSubshell "(foo\\ \nbar)"

prop_readNormalWord9 = isOk readSubshell "(foo\\ ;\nbar)"

readNormalWord = readNormalishWord ""

readNormalishWord end = do

id <- getNextId

pos <- getPosition

x <- many1 (readNormalWordPart end)

checkPossibleTermination pos x

return $ T_NormalWord id x

readIndexSpan = do

id <- getNextId

x <- many (readNormalWordPart "]" <|> someSpace <|> otherLiteral)

return $ T_NormalWord id x

where

someSpace = do

id <- getNextId

str <- spacing1

return $ T_Literal id str

otherLiteral = do

id <- getNextId

str <- many1 $ oneOf quotableChars

return $ T_Literal id str

checkPossibleTermination pos [T_Literal _ x] =

when (x `elem` ["do", "done", "then", "fi", "esac"]) $

parseProblemAt pos WarningC 1010 $ "Use semicolon or linefeed before '" ++ x ++ "' (or quote to make it literal)."

checkPossibleTermination _ _ = return ()

readNormalWordPart end = do

notFollowedBy2 $ oneOf end

checkForParenthesis

choice [

readSingleQuoted,

readDoubleQuoted,

readGlob,

readNormalDollar,

readBraced,

readUnquotedBackTicked,

readProcSub,

readNormalLiteral end,

readLiteralCurlyBraces

]

where

checkForParenthesis =

return () `attempting` do

pos <- getPosition

lookAhead $ char '('

parseProblemAt pos ErrorC 1036 "'(' is invalid here. Did you forget to escape it?"

readLiteralCurlyBraces = do

id <- getNextId

str <- findParam <|> literalBraces

return $ T_Literal id str

findParam = try $ string "{}"

literalBraces = do

pos <- getPosition

c <- oneOf "{}"

parseProblemAt pos WarningC 1083 $

"This " ++ [c] ++ " is literal. Check expression (missing ;/\\n?) or quote it."

return [c]

readSpacePart = do

id <- getNextId

x <- many1 whitespace

return $ T_Literal id x