Distribution/Simple/Program/ResponseFile.hs

    {-# 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 verbosity tmpFileOpts workDir fileNameTemplate encoding arguments f =
      withTempFileEx tmpFileOpts workDir fileNameTemplate $ \responseFileName hf -> do
        traverse_ (hSetEncoding hf) encoding
        let responseContents = unlines $ map escapeResponseFileArg arguments
        hPutStr hf responseContents
        hClose hf
        debug verbosity $ responseFileName ++ " contents: <<<"
        debug verbosity responseContents
        debug verbosity $ ">>> " ++ responseFileName
        f 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 = reverse . foldl' escape []
      where
        escape :: String -> Char -> String
        escape cs c =
          case c of
            '\\'          -> c:'\\':cs
            '\''          -> c:'\\':cs
            '"'           -> c:'\\':cs
            _ | isSpace c -> c:'\\':cs
              | otherwise -> c:cs