Make end pos non-optional
This commit is contained in:
parent
b9a9eb2529
commit
4111ce8fde
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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 =>
|
||||||
|
|
Loading…
Reference in New Issue