{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes       #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.Program.ResponseFile
-- Copyright   :  (c) Sergey Vinokurov 2017
-- License     :  BSD3-style
--
-- Maintainer  :  cabal-devel@haskell.org
-- Created     :  23 July 2017
----------------------------------------------------------------------------

module Distribution.Simple.Program.ResponseFile (withResponseFile) where

import Prelude ()
import System.IO (TextEncoding, hSetEncoding, hPutStr, hClose)

import Distribution.Compat.Prelude
import Distribution.Simple.Utils (TempFileOptions, withTempFileEx, debug)
import Distribution.Verbosity

withResponseFile
  :: Verbosity
  -> TempFileOptions
  -> FilePath           -- ^ Working directory to create response file in.
  -> FilePath           -- ^ Template for response file name.
  -> Maybe TextEncoding -- ^ Encoding to use for response file contents.
  -> [String]           -- ^ Arguments to put into response file.
  -> (FilePath -> IO a)
  -> IO a
withResponseFile :: forall a.
Verbosity
-> TempFileOptions
-> FilePath
-> FilePath
-> Maybe TextEncoding
-> [FilePath]
-> (FilePath -> IO a)
-> IO a
withResponseFile Verbosity
verbosity TempFileOptions
tmpFileOpts FilePath
workDir FilePath
fileNameTemplate Maybe TextEncoding
encoding [FilePath]
arguments FilePath -> IO a
f =
  TempFileOptions
-> FilePath -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
forall a.
TempFileOptions
-> FilePath -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
withTempFileEx TempFileOptions
tmpFileOpts FilePath
workDir FilePath
fileNameTemplate ((FilePath -> Handle -> IO a) -> IO a)
-> (FilePath -> Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FilePath
responseFileName Handle
hf -> do
    (TextEncoding -> IO ()) -> Maybe TextEncoding -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> TextEncoding -> IO ()
hSetEncoding Handle
hf) Maybe TextEncoding
encoding
    let responseContents :: FilePath
responseContents = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
escapeResponseFileArg [FilePath]
arguments
    Handle -> FilePath -> IO ()
hPutStr Handle
hf FilePath
responseContents
    Handle -> IO ()
hClose Handle
hf
    Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
responseFileName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" contents: <<<"
    Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity FilePath
responseContents
    Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
">>> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
responseFileName
    FilePath -> IO a
f FilePath
responseFileName

-- Support a gcc-like response file syntax.  Each separate
-- argument and its possible parameter(s), will be separated in the
-- response file by an actual newline; all other whitespace,
-- single quotes, double quotes, and the character used for escaping
-- (backslash) are escaped.  The called program will need to do a similar
-- inverse operation to de-escape and re-constitute the argument list.
escapeResponseFileArg :: String -> String
escapeResponseFileArg :: FilePath -> FilePath
escapeResponseFileArg = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Char -> FilePath) -> FilePath -> FilePath -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FilePath -> Char -> FilePath
escape []
  where
    escape :: String -> Char -> String
    escape :: FilePath -> Char -> FilePath
escape FilePath
cs Char
c =
      case Char
c of
        Char
'\\'          -> Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
cs
        Char
'\''          -> Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
cs
        Char
'"'           -> Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
cs
        Char
_ | Char -> Bool
isSpace Char
c -> Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'\\'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
cs
          | Bool
otherwise -> Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
cs