picnoir
/
hnix
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Nix/Parser.hs
View File

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