From e41d9e34bbb93a594b09fa390140149897a9112f Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Tue, 28 Oct 2014 15:02:29 +0000
Subject: [PATCH] Show paths relative to the current directory in progress
 reports

It is much nicer to see something like

- compiling FoodsSwe.gf...   write file FoodsSwe.gfo
- compiling FoodsTha.gf...   write file FoodsTha.gfo
- compiling FoodsTsn.gf...   write file FoodsTsn.gfo
- compiling FoodsTur.gf...   write file FoodsTur.gfo
- compiling FoodsUrd.gf...   write file FoodsUrd.gfo
linking ... OK
Writing Foods.pgf...

instead of

- compiling /Users/hallgren/src/GF/gf/examples/foods/FoodsSwe.gf...   write file /Users/hallgren/src/GF/gf/examples/foods/FoodsSwe.gfo
- compiling /Users/hallgren/src/GF/gf/examples/foods/FoodsTha.gf...   write file /Users/hallgren/src/GF/gf/examples/foods/FoodsTha.gfo
- compiling /Users/hallgren/src/GF/gf/examples/foods/FoodsTsn.gf...   write file /Users/hallgren/src/GF/gf/examples/foods/FoodsTsn.gfo
- compiling /Users/hallgren/src/GF/gf/examples/foods/FoodsTur.gf...   write file /Users/hallgren/src/GF/gf/examples/foods/FoodsTur.gfo
- compiling /Users/hallgren/src/GF/gf/examples/foods/FoodsUrd.gf...   write file /Users/hallgren/src/GF/gf/examples/foods/FoodsUrd.gfo
linking ... OK
Writing Foods.pgf...
---
 src/compiler/GF/CompileOne.hs | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs
index 3851b1f79..6aac4011b 100644
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -24,6 +24,7 @@ import GF.Infra.CheckM(runCheck')
 import GF.Data.Operations(ErrorMonad,liftErr,(+++),done)
 
 import GF.System.Directory(doesFileExist,getCurrentDirectory,renameFile)
+import System.FilePath(makeRelative)
 import qualified Data.Map as Map
 import GF.Text.Pretty(render,(<+>),($$)) --Doc,
 import Control.Monad((<=<))
@@ -48,14 +49,15 @@ compileOne opts srcgr file =
 -- | Read a compiled GF module.
 -- Also undo common subexp optimization, to enable normal computations.
 reuseGFO opts srcgr file =
-  do sm00 <- putPointE Verbose opts ("+ reading" +++ file) $
+  do cwd <- getCurrentDirectory
+     let rfile = makeRelative cwd file
+     sm00 <- putPointE Verbose opts ("+ reading" +++ rfile) $
              decodeModule file
      let sm0 = (fst sm00,(snd sm00){mflags=mflags (snd sm00) `addOptions` opts})
 
      idump opts Source sm0
 
      let sm1 = unsubexpModule sm0
-     cwd <- getCurrentDirectory
      (sm,warnings) <- -- putPointE Normal opts "creating indirections" $ 
                       runCheck' opts $ extendModule cwd srcgr sm1
      warnOut opts warnings
@@ -71,11 +73,12 @@ reuseGFO opts srcgr file =
 -- stores it in a @.gfo@ file
 -- (or a tags file, if running with the @-tags@ option)
 useTheSource opts srcgr file =
-      do sm <- putpOpt ("- parsing" +++ file)
-                       ("- compiling" +++ file ++ "... ")
+      do cwd <- getCurrentDirectory
+         let rfile = makeRelative cwd file
+         sm <- putpOpt ("- parsing" +++ rfile)
+                       ("- compiling" +++ rfile ++ "... ")
                        (getSourceModule opts file)
          idump opts Source sm
-         cwd <- getCurrentDirectory
          compileSourceModule opts cwd (Just file) srcgr sm
   where
     putpOpt v m act
@@ -85,7 +88,7 @@ useTheSource opts srcgr file =
 
 type CompileSource = Grammar -> Module -> IOE OneOutput
 
---compileSourceModule :: Options -> FilePath -> Maybe FilePath -> CompileSource
+--compileSourceModule :: Options -> InitPath -> Maybe FilePath -> CompileSource
 compileSourceModule opts cwd mb_gfFile gr =
     if flag optTagsOnly opts
     then generateTags <=< ifComplete middle               <=< frontend
@@ -111,7 +114,7 @@ compileSourceModule opts cwd mb_gfFile gr =
 
     generateGFO mo =
       do let mb_gfo = fmap (gf2gfo opts) mb_gfFile
-         maybeM (flip (writeGFO opts) mo) mb_gfo
+         maybeM (flip (writeGFO opts cwd) mo) mb_gfo
          return (mb_gfo,mo)
 
     generateTags mo =
@@ -135,12 +138,13 @@ compileSourceModule opts cwd mb_gfFile gr =
     maybeM f = maybe done f
 
 
---writeGFO :: Options -> FilePath -> SourceModule -> IOE ()
-writeGFO opts file mo =
-    putPointE Normal opts ("  write file" +++ file) $
+--writeGFO :: Options -> InitPath -> FilePath -> SourceModule -> IOE ()
+writeGFO opts cwd file mo =
+    putPointE Normal opts ("  write file" +++ rfile) $
       do encodeModule tmp mo2
          renameFile tmp file
   where
+    rfile = makeRelative cwd file
     tmp = file++".tmp"
     mo2 = (m,mi{jments=Map.filter notAnyInd (jments mi)})
     (m,mi) = subexpModule mo