From a98f4aa4be7b72a310a8b5826e3cc82c7edb8f40 Mon Sep 17 00:00:00 2001 From: hallgren Date: Fri, 6 Dec 2013 15:43:34 +0000 Subject: Show relative file paths in error messages This is to avoid one trivial reason for failures in the test suite. --- src/compiler/GF/Compile/GetGrammar.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src/compiler/GF/Compile/GetGrammar.hs') diff --git a/src/compiler/GF/Compile/GetGrammar.hs b/src/compiler/GF/Compile/GetGrammar.hs index 10a857bf9..6393d51d2 100644 --- a/src/compiler/GF/Compile/GetGrammar.hs +++ b/src/compiler/GF/Compile/GetGrammar.hs @@ -33,18 +33,20 @@ import Data.Char(isAscii) import Control.Monad (foldM,when,unless) import System.Cmd (system) --import System.IO(mkTextEncoding) --,utf8 -import System.Directory(removeFile) +import System.Directory(removeFile,getCurrentDirectory) +import System.FilePath(makeRelative) getSourceModule :: Options -> FilePath -> IOE SourceModule getSourceModule opts file0 = - errIn file0 $ +--errIn file0 $ do tmp <- lift $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts) raw <- lift $ keepTemp tmp --ePutStrLn $ "1 "++file0 (optCoding,parsed) <- parseSource opts pModDef raw case parsed of Left (Pn l c,msg) -> do file <- lift $ writeTemp tmp - let location = file++":"++show l++":"++show c + cwd <- lift $ getCurrentDirectory + let location = makeRelative cwd file++":"++show l++":"++show c raise (location++":\n "++msg) Right (i,mi0) -> do lift $ removeTemp tmp -- cgit v1.2.3