Cabal/src/Distribution/Simple/Program/ResponseFile.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE RankNTypes #-}
   3
   4 ----------------------------------------------------------------------------
   5
   6 ----------------------------------------------------------------------------
   7
   8 -- |
   9 -- Module      :  Distribution.Simple.Program.ResponseFile
  10 -- Copyright   :  (c) Sergey Vinokurov 2017
  11 -- License     :  BSD3-style
  12 --
  13 -- Maintainer  :  cabal-devel@haskell.org
  14 -- Created     :  23 July 2017
  15 module Distribution.Simple.Program.ResponseFile (withResponseFile) where
  16
  17 import System.IO (TextEncoding, hClose, hPutStr, hSetEncoding)
  18 import Prelude ()
  19
  20 import Distribution.Compat.Prelude
  21 import Distribution.Simple.Utils (TempFileOptions, debug, withTempFileEx)
  22 import Distribution.Verbosity
  23
  24 withResponseFile
  25   :: Verbosity
  26   -> TempFileOptions
  27   -> FilePath
  28   -- ^ Working directory to create response file in.
  29   -> FilePath
  30   -- ^ Template for response file name.
  31   -> Maybe TextEncoding
  32   -- ^ Encoding to use for response file contents.
  33   -> [String]
  34   -- ^ Arguments to put into response file.
  35   -> (FilePath -> IO a)
  36   -> IO a
  37 withResponseFile verbosity tmpFileOpts workDir fileNameTemplate encoding arguments f =
  38   withTempFileEx tmpFileOpts workDir fileNameTemplate $ \responseFileName hf -> do
  39     traverse_ (hSetEncoding hf) encoding
  40     let responseContents = unlines $ map escapeResponseFileArg arguments
  41     hPutStr hf responseContents
  42     hClose hf
  43     debug verbosity $ responseFileName ++ " contents: <<<"
  44     debug verbosity responseContents
  45     debug verbosity $ ">>> " ++ responseFileName
  46     f responseFileName
  47
  48 -- Support a gcc-like response file syntax.  Each separate
  49 -- argument and its possible parameter(s), will be separated in the
  50 -- response file by an actual newline; all other whitespace,
  51 -- single quotes, double quotes, and the character used for escaping
  52 -- (backslash) are escaped.  The called program will need to do a similar
  53 -- inverse operation to de-escape and re-constitute the argument list.
  54 escapeResponseFileArg :: String -> String
  55 escapeResponseFileArg = reverse . foldl' escape []
  56   where
  57     escape :: String -> Char -> String
  58     escape cs c =
  59       case c of
  60         '\\' -> c : '\\' : cs
  61         '\'' -> c : '\\' : cs
  62         '"' -> c : '\\' : cs
  63         _
  64           | isSpace c -> c : '\\' : cs
  65           | otherwise -> c : cs