-- | 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 :: FilePath -> Result -> IO ()
writeFiles FilePath
root =
  ((FilePath, FilePath) -> IO ()) -> Result -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> (FilePath, FilePath) -> IO ()
writeFile' FilePath
root)

-- writes file and creates directory if missing
writeFile' :: FilePath -> (FilePath, String) -> IO ()
writeFile' :: FilePath -> (FilePath, FilePath) -> IO ()
writeFile' FilePath
root (FilePath
path,FilePath
content) = do
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
dropFileName FilePath
path)
  FilePath -> FilePath -> IO ()
writeFileRep (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
path) FilePath
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 :: FilePath -> FilePath -> IO ()
writeFileRep FilePath
path FilePath
s =
    (IOError -> IO ())
-> (FilePath -> IO ()) -> Either IOError FilePath -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO ()
forall p. p -> IO ()
newFile FilePath -> IO ()
updateFile (Either IOError FilePath -> IO ())
-> IO (Either IOError FilePath) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath -> IO (Either IOError FilePath)
forall a. IO a -> IO (Either IOError a)
tryIOError (FilePath -> IO FilePath
readFile' FilePath
path)
  where
    -- Case: file does not exist yet.
    newFile :: p -> IO ()
newFile p
_ = do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"writing new file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
      FilePath -> FilePath -> IO ()
writeFile FilePath
path FilePath
s

    -- Case: file exists with content @old@.
    updateFile :: FilePath -> IO ()
updateFile FilePath
old = do
      -- Write new content.
      FilePath -> FilePath -> IO ()
writeFile FilePath
path FilePath
s
      if FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
old  -- test is O(1) space, O(n) time
         then do
           FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"refreshing unchanged file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
         else do
           let bak :: FilePath
bak = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".bak"
           FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"writing file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (saving old file as " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
bak FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
           FilePath -> FilePath -> IO ()
writeFile FilePath
bak FilePath
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' :: FilePath -> IO FilePath
readFile' FilePath
path' = do
      Handle
inFile   <- FilePath -> IOMode -> IO Handle
openFile FilePath
path' IOMode
ReadMode
      FilePath
contents <- Handle -> IO FilePath
hGetContents Handle
inFile
      FilePath -> ()
forall a. NFData a => a -> ()
rnf FilePath
contents () -> IO () -> IO ()
`seq` Handle -> IO ()
hClose Handle
inFile
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
contents