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/Infra/CheckM.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'src/compiler/GF/Infra') diff --git a/src/compiler/GF/Infra/CheckM.hs b/src/compiler/GF/Infra/CheckM.hs index f1d4ebbde..045ba4852 100644 --- a/src/compiler/GF/Infra/CheckM.hs +++ b/src/compiler/GF/Infra/CheckM.hs @@ -15,17 +15,18 @@ module GF.Infra.CheckM (Check, CheckResult, Message, runCheck, checkError, checkCond, checkWarn, checkWarnings, checkAccumError, - {-checkErr,-} checkIn, checkMap, checkMapRecover, + checkIn, checkInModule, checkMap, checkMapRecover, parallelCheck, accumulateError, commitCheck, ) where import GF.Data.Operations --import GF.Infra.Ident ---import GF.Grammar.Grammar(Context) ---import GF.Grammar.Printer +import GF.Grammar.Grammar(msrc) -- ,Context +import GF.Grammar.Printer(ppLocation) import qualified Data.Map as Map import Text.PrettyPrint +import System.FilePath(makeRelative) import Control.Parallel.Strategies(parList,rseq,using) import Control.Monad(liftM) @@ -146,3 +147,10 @@ checkIn msg c = Check $ \{-ctxt-} msgs0 -> augment' msgs0 msgs' = (msg $$ nest 3 (vcat (reverse msgs'))):msgs0 augment1 msg' = msg $$ nest 3 msg' + +-- | Augment error messages with a relative path to the source module and +-- an contextual hint (which can be left 'empty') +checkInModule cwd mi loc context = + checkIn (ppLocation relpath loc <> colon $$ nest 2 context) + where + relpath = makeRelative cwd (msrc mi) -- cgit v1.2.3