Show relative file paths in error messages

This is to avoid one trivial reason for failures in the test suite.

1 files changed, 5 insertions, 3 deletions

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