Use pre-whitespace position for source end locations

Fixes https://github.com/haskell-nix/hnix/issues/743
This commit is contained in:
Joe Hermaszewski 2020-10-25 17:15:36 +08:00
parent 820499daff
commit 731ed878e1
1 changed files with 15 additions and 9 deletions

View File

@ -53,13 +53,13 @@ import Control.Applicative hiding ( many
import Control.DeepSeq
import Control.Monad
import Control.Monad.Combinators.Expr
import Control.Monad.State.Strict
import Data.Char ( isAlpha
, isDigit
, isSpace
)
import Data.Data ( Data(..) )
import Data.Functor
import Data.Functor.Identity
import Data.HashSet ( HashSet )
import qualified Data.HashSet as HashSet
import Data.List.NonEmpty ( NonEmpty(..) )
@ -81,7 +81,7 @@ import Nix.Render
import Prettyprinter ( Doc
, pretty
)
import Text.Megaparsec
import Text.Megaparsec hiding ( State )
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
@ -439,7 +439,9 @@ skipLineComment' prefix = string prefix
*> void (takeWhileP (Just "character") (\x -> x /= '\n' && x /= '\r'))
whiteSpace :: Parser ()
whiteSpace = L.space space1 lineCmnt blockCmnt
whiteSpace = do
put =<< getSourcePos
L.space space1 lineCmnt blockCmnt
where
lineCmnt = skipLineComment' "#"
blockCmnt = L.skipBlockComment "/*" "*/"
@ -513,20 +515,24 @@ reservedNames :: HashSet Text
reservedNames = HashSet.fromList
["let", "in", "if", "then", "else", "assert", "with", "rec", "inherit"]
type Parser = ParsecT Void Text Identity
type Parser = ParsecT Void Text (State SourcePos)
data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a)
parseFromFileEx p path = do
txt <- decodeUtf8 <$> readFile path
pure $ either (Failure . pretty . errorBundlePretty) Success $ parse p
path
txt
pure
$ either (Failure . pretty . errorBundlePretty) Success
. flip evalState (initialPos path)
$ runParserT p path txt
parseFromText :: Parser a -> Text -> Result a
parseFromText p txt =
either (Failure . pretty . errorBundlePretty) Success $ parse p "<string>" txt
let file = "<string>"
in either (Failure . pretty . errorBundlePretty) Success
. flip evalState (initialPos file)
$ runParserT p file txt
{- Parser.Operators -}
@ -546,7 +552,7 @@ annotateLocation :: Parser a -> Parser (Ann SrcSpan a)
annotateLocation p = do
begin <- getSourcePos
res <- p
end <- getSourcePos
end <- get -- The state set before the last whitespace
pure $ Ann (SrcSpan begin end) res
annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc