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