@@ -53,14 +53,14 @@ import Control.Applicative hiding ( many
5353import Control.DeepSeq
5454import Control.Monad
5555import Control.Monad.Combinators.Expr
56+ import Control.Monad.State.Strict
5657import Data.Char ( isAlpha
5758 , isDigit
5859 , isSpace
5960 )
6061import Data.Data ( Data (.. ) )
6162import Data.Fix ( Fix (.. ) )
6263import Data.Functor
63- import Data.Functor.Identity
6464import Data.HashSet ( HashSet )
6565import qualified Data.HashSet as HashSet
6666import Data.List.NonEmpty ( NonEmpty (.. ) )
@@ -82,7 +82,7 @@ import Nix.Render
8282import Prettyprinter ( Doc
8383 , pretty
8484 )
85- import Text.Megaparsec
85+ import Text.Megaparsec hiding ( State )
8686import Text.Megaparsec.Char
8787import qualified Text.Megaparsec.Char.Lexer as L
8888
@@ -443,7 +443,9 @@ skipLineComment' prefix = string prefix
443443 *> void (takeWhileP (Just " character" ) (\ x -> x /= ' \n ' && x /= ' \r ' ))
444444
445445whiteSpace :: Parser ()
446- whiteSpace = L. space space1 lineCmnt blockCmnt
446+ whiteSpace = do
447+ put =<< getSourcePos
448+ L. space space1 lineCmnt blockCmnt
447449 where
448450 lineCmnt = skipLineComment' " #"
449451 blockCmnt = L. skipBlockComment " /*" " */"
@@ -524,20 +526,24 @@ reservedNames :: HashSet Text
524526reservedNames = HashSet. fromList
525527 [" let" , " in" , " if" , " then" , " else" , " assert" , " with" , " rec" , " inherit" ]
526528
527- type Parser = ParsecT Void Text Identity
529+ type Parser = ParsecT Void Text ( State SourcePos )
528530
529531data Result a = Success a | Failure (Doc Void ) deriving (Show , Functor )
530532
531533parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a )
532534parseFromFileEx p path = do
533535 txt <- decodeUtf8 <$> readFile path
534- pure $ either (Failure . pretty . errorBundlePretty) Success $ parse p
535- path
536- txt
536+ pure
537+ $ either (Failure . pretty . errorBundlePretty) Success
538+ . flip evalState (initialPos path)
539+ $ runParserT p path txt
537540
538541parseFromText :: Parser a -> Text -> Result a
539542parseFromText p txt =
540- either (Failure . pretty . errorBundlePretty) Success $ parse p " <string>" txt
543+ let file = " <string>"
544+ in either (Failure . pretty . errorBundlePretty) Success
545+ . flip evalState (initialPos file)
546+ $ runParserT p file txt
541547
542548{- Parser.Operators -}
543549
@@ -557,7 +563,7 @@ annotateLocation :: Parser a -> Parser (Ann SrcSpan a)
557563annotateLocation p = do
558564 begin <- getSourcePos
559565 res <- p
560- end <- getSourcePos
566+ end <- get -- The state set before the last whitespace
561567 pure $ Ann (SrcSpan begin end) res
562568
563569annotateLocation1 :: Parser (NExprF NExprLoc ) -> Parser NExprLoc
0 commit comments