mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-13 06:49:31 -06:00
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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user