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...
This commit is contained in:
hallgren
2014-10-28 15:02:29 +00:00
parent f085b807eb
commit e41d9e34bb

View File

@@ -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