Make end pos non-optional

This commit is contained in:
Ng Zhi An 2018-06-12 22:39:06 -07:00
parent b9a9eb2529
commit 4111ce8fde
3 changed files with 11 additions and 14 deletions

View File

@ -39,13 +39,10 @@ import Control.Monad
import Test.QuickCheck.All import Test.QuickCheck.All
tokenToPosition startMap (TokenComment id c) = fromMaybe fail $ do tokenToPosition startMap (TokenComment id c) = fromMaybe fail $ do
position <- maybePosition span <- Map.lookup id startMap
endPosition <- maybeEndPosition <|> maybePosition return $ PositionedComment (fst span) (snd span) 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!"
maybePosition = fmap fst $ 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

View File

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

View File

@ -151,7 +151,7 @@ data HereDocContext =
data UserState = UserState { data UserState = UserState {
lastId :: Id, lastId :: Id,
positionMap :: Map.Map Id (SourcePos, Maybe SourcePos), positionMap :: Map.Map Id (SourcePos, SourcePos),
parseNotes :: [ParseNote], parseNotes :: [ParseNote],
hereDocMap :: Map.Map Id [Token], hereDocMap :: Map.Map Id [Token],
pendingHereDocs :: [HereDocContext] pendingHereDocs :: [HereDocContext]
@ -175,7 +175,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, Just sourcepos) (positionMap state) let newMap = Map.insert newId (sourcepos, sourcepos) (positionMap state)
putState $ state { putState $ state {
lastId = newId, lastId = newId,
positionMap = newMap positionMap = newMap
@ -197,7 +197,7 @@ endSpan (IncompleteInterval start) = do
id <- getNextIdAt start id <- getNextIdAt start
endPos <- getPosition endPos <- getPosition
state <- getState state <- getState
let setEndPos (start, _) = Just (start, Just endPos) let setEndPos (start, _) = Just (start, endPos)
let newMap = Map.update setEndPos id (positionMap state) let newMap = Map.update setEndPos id (positionMap state)
putState $ state { putState $ state {
lastId = id, lastId = id,
@ -335,9 +335,9 @@ 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 (start, end) = 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 parseProblemAtWithEnd start end level code msg
-- Store non-parse problems inside -- Store non-parse problems inside
@ -2936,7 +2936,7 @@ debugParseScript string =
posFile = "removed for clarity", posFile = "removed for clarity",
posLine = -1, posLine = -1,
posColumn = -1 posColumn = -1
}, Just Position { }, Position {
posFile = "removed for clarity", posFile = "removed for clarity",
posLine = -1, posLine = -1,
posColumn = -1 posColumn = -1
@ -3108,8 +3108,8 @@ posToPos sp = Position {
posColumn = fromIntegral $ sourceColumn sp posColumn = fromIntegral $ sourceColumn sp
} }
startEndPosToPos :: (SourcePos, Maybe SourcePos) -> (Position, Maybe Position) startEndPosToPos :: (SourcePos, SourcePos) -> (Position, Position)
startEndPosToPos (s, me) = (posToPos s, fmap posToPos me) startEndPosToPos (s, e) = (posToPos s, posToPos e)
-- 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 =>