Merge end pos map into start pos map

This commit is contained in:
Ng Zhi An 2018-05-26 23:25:22 -07:00
parent 4470fe715c
commit 48ac654a93
3 changed files with 26 additions and 33 deletions

View file

@ -38,14 +38,14 @@ import Control.Monad
import Test.QuickCheck.All import Test.QuickCheck.All
tokenToPosition startMap endMap (TokenComment id c) = fromMaybe fail $ do tokenToPosition startMap (TokenComment id c) = fromMaybe fail $ do
position <- maybePosition position <- maybePosition
endPosition <- maybeEndPosition <|> maybePosition endPosition <- maybeEndPosition <|> maybePosition
return $ PositionedComment position endPosition c return $ PositionedComment position endPosition c
where where
fail = error "Internal shellcheck error: id doesn't exist. Please report!" fail = error "Internal shellcheck error: id doesn't exist. Please report!"
maybeEndPosition = Map.lookup id endMap maybePosition = fmap fst $ Map.lookup id startMap
maybePosition = Map.lookup id startMap maybeEndPosition = join $ fmap snd $ Map.lookup id startMap
checkScript :: Monad m => SystemInterface m -> CheckSpec -> m CheckResult checkScript :: Monad m => SystemInterface m -> CheckSpec -> m CheckResult
checkScript sys spec = do checkScript sys spec = do
@ -66,7 +66,7 @@ checkScript sys spec = do
fromMaybe [] $ fromMaybe [] $
(arComments . analyzeScript . analysisSpec) (arComments . analyzeScript . analysisSpec)
<$> prRoot result <$> prRoot result
let translator = tokenToPosition (prTokenPositions result) (prTokenEndPositions result) let translator = tokenToPosition (prTokenPositions result)
return . nub . sortMessages . filter shouldInclude $ return . nub . sortMessages . filter shouldInclude $
(parseMessages ++ map translator analysisMessages) (parseMessages ++ map translator analysisMessages)

View file

@ -61,8 +61,7 @@ data ParseSpec = ParseSpec {
data ParseResult = ParseResult { data ParseResult = ParseResult {
prComments :: [PositionedComment], prComments :: [PositionedComment],
prTokenPositions :: Map.Map Id Position, prTokenPositions :: Map.Map Id (Position, Maybe Position),
prTokenEndPositions :: Map.Map Id Position,
prRoot :: Maybe Token prRoot :: Maybe Token
} deriving (Show, Eq) } deriving (Show, Eq)

View file

@ -136,15 +136,14 @@ almostSpace =
char c char c
return ' ' return ' '
withNextId :: Monad m => ParsecT s UserState (SCBase m) (Id -> b) -> ParsecT s UserState (SCBase m) b withNextId :: Monad m => SCParser m (Id -> b) -> SCParser m b
withNextId p = do withNextId p = do
start <- getPosition start <- getPosition
id <- createId id <- createId
setStartPos id start
fn <- p fn <- p
let t = fn id let t = fn id
end <- getPosition end <- getPosition
setEndPos id end setPos id start end
return t return t
where where
createId = do createId = do
@ -155,18 +154,12 @@ withNextId p = do
} }
return id return id
where incId (Id n) = Id $ n+1 where incId (Id n) = Id $ n+1
setStartPos id sourcepos = do setPos id start end = do
state <- getState state <- getState
let newMap = Map.insert id sourcepos (positionMap state) let newMap = Map.insert id (start, Just end) (positionMap state)
putState $ state { putState $ state {
positionMap = newMap positionMap = newMap
} }
setEndPos id sourcepos = do
state <- getState
let newMap = Map.insert id sourcepos (positionEndMap state)
putState $ state {
positionEndMap = newMap
}
--------- Message/position annotation on top of user state --------- Message/position annotation on top of user state
data Note = Note Id Severity Code String deriving (Show, Eq) data Note = Note Id Severity Code String deriving (Show, Eq)
@ -183,8 +176,7 @@ data HereDocContext =
data UserState = UserState { data UserState = UserState {
lastId :: Id, lastId :: Id,
positionMap :: Map.Map Id SourcePos, positionMap :: Map.Map Id (SourcePos, Maybe SourcePos),
positionEndMap :: Map.Map Id SourcePos,
parseNotes :: [ParseNote], parseNotes :: [ParseNote],
hereDocMap :: Map.Map Id [Token], hereDocMap :: Map.Map Id [Token],
pendingHereDocs :: [HereDocContext] pendingHereDocs :: [HereDocContext]
@ -192,7 +184,6 @@ data UserState = UserState {
initialUserState = UserState { initialUserState = UserState {
lastId = Id $ -1, lastId = Id $ -1,
positionMap = Map.empty, positionMap = Map.empty,
positionEndMap = Map.empty,
parseNotes = [], parseNotes = [],
hereDocMap = Map.empty, hereDocMap = Map.empty,
pendingHereDocs = [] pendingHereDocs = []
@ -210,7 +201,7 @@ getLastId = lastId <$> getState
getNextIdAt sourcepos = do getNextIdAt sourcepos = do
state <- getState state <- getState
let newId = incId (lastId state) let newId = incId (lastId state)
let newMap = Map.insert newId sourcepos (positionMap state) let newMap = Map.insert newId (sourcepos, Just sourcepos) (positionMap state)
putState $ state { putState $ state {
lastId = newId, lastId = newId,
positionMap = newMap positionMap = newMap
@ -354,7 +345,7 @@ parseProblemAt pos = parseProblemAtWithEnd pos pos
parseProblemAtId :: Monad m => Id -> Severity -> Integer -> String -> SCParser m () parseProblemAtId :: Monad m => Id -> Severity -> Integer -> String -> SCParser m ()
parseProblemAtId id level code msg = do parseProblemAtId id level code msg = do
map <- getMap map <- getMap
let pos = Map.findWithDefault let (pos, _) = Map.findWithDefault
(error "Internal error (no position for id). Please report.") id map (error "Internal error (no position for id). Please report.") id map
parseProblemAt pos level code msg parseProblemAt pos level code msg
@ -1579,18 +1570,16 @@ prop_readDollarVariable3 = isWarning (readDollarVariable >> anyChar) "$10"
prop_readDollarVariable4 = isWarning (readDollarVariable >> string "[@]") "$arr[@]" prop_readDollarVariable4 = isWarning (readDollarVariable >> string "[@]") "$arr[@]"
prop_readDollarVariable5 = isWarning (readDollarVariable >> string "[f") "$arr[f" prop_readDollarVariable5 = isWarning (readDollarVariable >> string "[f") "$arr[f"
readDollarVariable :: Monad m => ParsecT String UserState (SCBase m) Token readDollarVariable :: Monad m => SCParser m Token
readDollarVariable = withNextId $ do readDollarVariable = withNextId $ do
pos <- getPosition pos <- getPosition
let let singleCharred p = do
singleCharred p = do
n <- p n <- p
value <- wrap [n] value <- wrap [n]
return $ \id -> (T_DollarBraced id value) return $ \id -> (T_DollarBraced id value)
let let positional = do
positional = do
value <- singleCharred digit value <- singleCharred digit
return value `attempting` do return value `attempting` do
lookAhead digit lookAhead digit
@ -1679,7 +1668,7 @@ readPendingHereDocs = do
swapContext ctx $ swapContext ctx $
do do
docPos <- getPosition docPos <- getPosition
tokenPos <- Map.findWithDefault (error "Missing ID") id <$> getMap (tokenPos, _) <- Map.findWithDefault (error "Missing ID") id <$> getMap
(terminated, wasWarned, lines) <- readDocLines dashed endToken (terminated, wasWarned, lines) <- readDocLines dashed endToken
let hereData = unlines lines let hereData = unlines lines
unless terminated $ do unless terminated $ do
@ -2945,11 +2934,15 @@ debugParseScript string =
result { result {
-- Remove the noisiest parts -- Remove the noisiest parts
prTokenPositions = Map.fromList [ prTokenPositions = Map.fromList [
(Id 0, Position { (Id 0, (Position {
posFile = "removed for clarity", posFile = "removed for clarity",
posLine = -1, posLine = -1,
posColumn = -1 posColumn = -1
})] }, Just Position {
posFile = "removed for clarity",
posLine = -1,
posColumn = -1
}))]
} }
where where
result = runIdentity $ result = runIdentity $
@ -3036,8 +3029,7 @@ parseShell env name contents = do
Right (script, userstate) -> Right (script, userstate) ->
return ParseResult { return ParseResult {
prComments = map toPositionedComment $ nub $ parseNotes userstate ++ parseProblems state, prComments = map toPositionedComment $ nub $ parseNotes userstate ++ parseProblems state,
prTokenPositions = Map.map posToPos (positionMap userstate), prTokenPositions = Map.map startEndPosToPos (positionMap userstate),
prTokenEndPositions = Map.map posToPos (positionEndMap userstate),
prRoot = Just $ prRoot = Just $
reattachHereDocs script (hereDocMap userstate) reattachHereDocs script (hereDocMap userstate)
} }
@ -3049,7 +3041,6 @@ parseShell env name contents = do
++ [makeErrorFor err] ++ [makeErrorFor err]
++ parseProblems state, ++ parseProblems state,
prTokenPositions = Map.empty, prTokenPositions = Map.empty,
prTokenEndPositions = Map.empty,
prRoot = Nothing prRoot = Nothing
} }
@ -3119,6 +3110,9 @@ posToPos sp = Position {
posColumn = fromIntegral $ sourceColumn sp posColumn = fromIntegral $ sourceColumn sp
} }
startEndPosToPos :: (SourcePos, Maybe SourcePos) -> (Position, Maybe Position)
startEndPosToPos (s, me) = (posToPos s, fmap posToPos me)
-- TODO: Clean up crusty old code that this is layered on top of -- TODO: Clean up crusty old code that this is layered on top of
parseScript :: Monad m => parseScript :: Monad m =>
SystemInterface m -> ParseSpec -> m ParseResult SystemInterface m -> ParseSpec -> m ParseResult