GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

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?

Browse Source
This commit is contained in:
bjorn
2008-11-09 13:58:28 +00:00
parent 526d8409bd
commit 9dbb65055d
1 changed files with 11 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/GFC.hs
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