{-# 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 = optional carriageReturn >> char '\n'

singleQuote = char '\'' <|> unicodeSingleQuote

doubleQuote = char '"' <|> unicodeDoubleQuote

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

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

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

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

tokenDelimiter = oneOf "&|;<> \t\n\r" <|> almostSpace

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

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

bracedQuotable = oneOf "}\"$`'"

doubleQuotableChars = "\"$`" ++ unicodeDoubleQuoteChars

doubleQuotable = unicodeDoubleQuote <|> oneOf doubleQuotableChars

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

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 Severity Code String deriving (Show, Eq)

data Context =

ContextName SourcePos String

| ContextAnnotation [Annotation]

| ContextSource String

deriving (Show)

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

ParseNote 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 = do

pos <- getPosition

getNextIdAt pos

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)

parseProblemAt pos level code msg = do

irrelevant <- shouldIgnoreCode code

unless irrelevant $

Ms.modify (\state -> state {

parseProblems = note:parseProblems state

})

where

note = ParseNote pos level code msg

parseNote c l a = do

pos <- getPosition

parseNoteAt pos c l a

parseNoteAt pos c l a = addParseNote $ ParseNote pos 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 1009 "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 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 <- many1 (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 =

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

notFollowedBy2 $ oneOf "&|<>="

return s

) op)

spacing

return $ token id op

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 = readTrinary `splitBy` ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="]

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 = readMultiplication `splitBy` ["+", "-"]

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

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

readAnnotation = called "shellcheck annotation" $ do

try readAnnotationPrefix

many1 linewhitespace

values <- many1 (readDisable <|> readSourceOverride)

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]

forKey s p = do

try $ string s

char '='

value <- p

many linewhitespace

return value

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

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

readDollarBracedWord = do

id <- getNextId

list <- many readDollarBracedPart

return $ T_NormalWord id list

readDollarBracedPart = readSingleQuoted <|> readDoubleQuoted <|> readExtglob <|> readNormalDollar <|> readUnquotedBackTicked <|> readDollarBracedLiteral

readDollarBracedLiteral = do

id <- getNextId

vars <- (readBraceEscaped <|> (anyChar >>= \x -> return [x])) `reluctantlyTill1` bracedQuotable

return $ T_Literal id $ concat vars

prop_readProcSub1 = isOk readProcSub "<(echo test | wc -l)"

prop_readProcSub2 = isOk readProcSub "<( if true; then true; fi )"

prop_readProcSub3 = isOk readProcSub "<( # nothing here \n)"

readProcSub = called "process substitution" $ do

id <- getNextId

dir <- try $ do

x <- oneOf "<>"

char '('

return [x]

list <- readCompoundListOrEmpty

allspacing

char ')'

return $ T_ProcSub id dir list

prop_readSingleQuoted = isOk readSingleQuoted "'foo bar'"

prop_readSingleQuoted2 = isWarning readSingleQuoted "'foo bar\\'"

prop_readsingleQuoted3 = isWarning readSingleQuoted "\x2018hello\x2019"

prop_readSingleQuoted4 = isWarning readNormalWord "'it's"

prop_readSingleQuoted5 = isWarning readSimpleCommand "foo='bar\ncow 'arg"

prop_readSingleQuoted6 = isOk readSimpleCommand "foo='bar cow 'arg"

readSingleQuoted = called "single quoted string" $ do

id <- getNextId

startPos <- getPosition

singleQuote

s <- readSingleQuotedPart `reluctantlyTill` singleQuote

let string = concat s

endPos <- getPosition

singleQuote <|> fail "Expected end of single quoted string"

optional $ do

c <- try . lookAhead $ suspectCharAfterQuotes <|> oneOf "'"

if not (null string) && isAlpha c && isAlpha (last string)

then

parseProblemAt endPos WarningC 1011

"This apostrophe terminated the single quoted string!"

else

when ('\n' `elem` string && not ("\n" `isPrefixOf` string)) $

suggestForgotClosingQuote startPos endPos "single quoted string"

return (T_SingleQuoted id string)

readSingleQuotedLiteral = do

singleQuote

strs <- many1 readSingleQuotedPart

singleQuote

return $ concat strs

readSingleQuotedPart =

readSingleEscaped

<|> many1 (noneOf "'\\\x2018\x2019")

prop_readBackTicked = isOk (readBackTicked False) "`ls *.mp3`"

prop_readBackTicked2 = isOk (readBackTicked False) "`grep \"\\\"\"`"

prop_readBackTicked3 = isWarning (readBackTicked False) "´grep \"\\\"\"´"

prop_readBackTicked4 = isOk readSimpleCommand "`echo foo\necho bar`"

prop_readBackTicked5 = isOk readSimpleCommand "echo `foo`bar"

prop_readBackTicked6 = isWarning readSimpleCommand "echo `foo\necho `bar"

prop_readBackTicked7 = isOk readSimpleCommand "`#inline comment`"

prop_readBackTicked8 = isOk readSimpleCommand "echo `#comment` \\\nbar baz"

readQuotedBackTicked = readBackTicked True

readUnquotedBackTicked = readBackTicked False

readBackTicked quoted = called "backtick expansion" $ do

id <- getNextId

startPos <- getPosition

backtick

subStart <- getPosition

subString <- readGenericLiteral "`´"

endPos <- getPosition

backtick

optional $ do

c <- try . lookAhead $ suspectCharAfterQuotes

when ('\n' `elem` subString && not ("\n" `isPrefixOf` subString)) $

suggestForgotClosingQuote startPos endPos "backtick expansion"

-- Result positions may be off due to escapes

result <- subParse subStart subParser (unEscape subString)

return $ T_Backticked id result

where

unEscape [] = []

unEscape ('\\':'"':rest) | quoted = '"' : unEscape rest

unEscape ('\\':x:rest) | x `elem` "$`\\" = x : unEscape rest

unEscape ('\\':'\n':rest) = unEscape rest

unEscape (c:rest) = c : unEscape rest

subParser = do

cmds <- readCompoundListOrEmpty

verifyEof

return cmds

backtick =

disregard (char '`') <|> do

pos <- getPosition

char '´'

parseProblemAt pos ErrorC 1077

"For command expansion, the tick should slant left (` vs ´). Use $(..) instead."

subParse pos parser input = do

lastPosition <- getPosition

lastInput <- getInput

setPosition pos

setInput input

result <- parser

setInput lastInput

setPosition lastPosition

return result

inSeparateContext parser = do

context <- Ms.get

success context <|> failure context

where

success c = do

res <- try parser

Ms.put c

return res

failure c = do

Ms.put c

fail ""