{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
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
-> FilePath
-> Maybe TextEncoding
-> [String]
-> (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
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