1
0
forked from GitHub/gf-core

Fixed PGF file overwriting issue reported by Peter, by refusing to overwrite any of the input pgf files. Maybe the right fix would be to read the PGF strictly?

This commit is contained in:
bjorn
2008-11-09 13:58:28 +00:00
parent 526d8409bd
commit 9dbb65055d

View File

@@ -16,6 +16,7 @@ import GF.Data.ErrM
import Data.Maybe
import Data.Binary
import System.FilePath
import System.IO
mainGFC :: Options -> [FilePath] -> IOE ()
@@ -35,6 +36,7 @@ compileSourceFiles opts fs =
if flag optStopAfterPhase opts == Compile
then return ()
else do pgf <- link opts cnc gr
writePGF opts pgf
writeOutputs opts pgf
compileCFFiles :: Options -> [FilePath] -> IOE ()
@@ -46,28 +48,34 @@ compileCFFiles opts fs =
if flag optStopAfterPhase opts == Compile
then return ()
else do pgf <- link opts cnc gr
writePGF opts pgf
writeOutputs opts pgf
unionPGFFiles :: Options -> [FilePath] -> IOE ()
unionPGFFiles opts fs =
do pgfs <- mapM readPGFVerbose fs
let pgf = foldl1 unionPGF pgfs
pgfFile = grammarName opts pgf <.> "pgf"
if pgfFile `elem` fs
then putStrLnE $ "Refusing to overwrite " ++ pgfFile
else writePGF opts pgf
writeOutputs opts pgf
where readPGFVerbose f = putPointE Normal opts ("Reading " ++ f ++ "...") $ ioeIO $ readPGF f
writeOutputs :: Options -> PGF -> IOE ()
writeOutputs opts pgf = do
writePGF opts pgf
sequence_ [writeOutput opts name str
| fmt <- flag optOutputFormats opts,
(name,str) <- exportPGF opts fmt pgf]
writePGF :: Options -> PGF -> IOE ()
writePGF opts pgf = do
let name = fromMaybe (prCId (absname pgf)) (flag optName opts)
outfile = name <.> "pgf"
let outfile = grammarName opts pgf <.> "pgf"
putPointE Normal opts ("Writing " ++ outfile ++ "...") $ ioeIO $ encodeFile outfile pgf
grammarName :: Options -> PGF -> String
grammarName opts pgf = fromMaybe (prCId (absname pgf)) (flag optName opts)
writeOutput :: Options -> FilePath-> String -> IOE ()
writeOutput opts file str =
do let path = case flag optOutputDir opts of