-- | Backend write module. -- -- Defines useful functions to write the backend output to files. module BNFC.Backend.CommonInterface.Write (writeFiles) where import BNFC.Prelude import Control.DeepSeq (rnf) import System.Directory (createDirectoryIfMissing) import System.FilePath (dropFileName, ()) import System.IO (pattern ReadMode, hClose, hGetContents, openFile) import System.IO.Error import BNFC.Backend.CommonInterface.Backend writeFiles :: FilePath -> Result -> IO () writeFiles root = mapM_ (writeFile' root) -- writes file and creates directory if missing writeFile' :: FilePath -> (FilePath, String) -> IO () writeFile' root (path,content) = do createDirectoryIfMissing True (root dropFileName path) writeFileRep (root path) content -- | Write a file, after making a backup of an existing file with the same name. -- If an old version of the file exist and the new version is the same, -- keep the old file and don't create a .bak file. -- / New version by TH, 2010-09-23 writeFileRep :: FilePath -> String -> IO () writeFileRep path s = either newFile updateFile =<< tryIOError (readFile' path) where -- Case: file does not exist yet. newFile _ = do putStrLn $ "writing new file " ++ path writeFile path s -- Case: file exists with content @old@. updateFile old = do -- Write new content. writeFile path s if s == old -- test is O(1) space, O(n) time then do putStrLn $ "refreshing unchanged file " ++ path else do let bak = path ++ ".bak" putStrLn $ "writing file " ++ path ++ " (saving old file as " ++ bak ++ ")" writeFile bak old -- Force reading of contents of files to achieve compatibility with -- Windows IO handling, as combining lazy IO with `readFile` and -- 2x `renameFile` on the open `path` file complains with: -- -- "bnfc.exe: Makefile: MoveFileEx "Makefile" "Makefile.bak": permission -- denied (The process cannot access the file because it is being used -- by another process.)" readFile' :: FilePath -> IO String readFile' path' = do inFile <- openFile path' ReadMode contents <- hGetContents inFile rnf contents `seq` hClose inFile return contents