Commit 8807b4cd authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Support response files regardless of which GHC `hsc2hs` was compiled with

See also https://ghc.haskell.org/trac/ghc/ticket/15758

The hsc2hs-0.68.4 release was already revised with a lower bound `base >= 4.12` to
mitigate the issue solver-side
(http://hackage.haskell.org/package/hsc2hs-0.68.4/revisions/)

This improves upon #9
parent 0bac7b4a
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- taken from base-4.12.0.0's "GHC.ResponseFile"
module Compat.ResponseFile ( getArgsWithResponseFiles ) where
#if MIN_VERSION_base(4,12,0)
import GHC.ResponseFile (getArgsWithResponseFiles)
#else
import Control.Exception
import Data.Char (isSpace)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO
{-|
Like 'getArgs', but can also read arguments supplied via response files.
For example, consider a program @foo@:
@
main :: IO ()
main = do
args <- getArgsWithResponseFiles
putStrLn (show args)
@
And a response file @args.txt@:
@
--one 1
--'two' 2
--"three" 3
@
Then the result of invoking @foo@ with @args.txt@ is:
> > ./foo @args.txt
> ["--one","1","--two","2","--three","3"]
-}
getArgsWithResponseFiles :: IO [String]
getArgsWithResponseFiles = getArgs >>= expandResponse
-- | Given a string of concatenated strings, separate each by removing
-- a layer of /quoting/ and\/or /escaping/ of certain characters.
--
-- These characters are: any whitespace, single quote, double quote,
-- and the backslash character. The backslash character always
-- escapes (i.e., passes through without further consideration) the
-- character which follows. Characters can also be escaped in blocks
-- by quoting (i.e., surrounding the blocks with matching pairs of
-- either single- or double-quotes which are not themselves escaped).
--
-- Any whitespace which appears outside of either of the quoting and
-- escaping mechanisms, is interpreted as having been added by this
-- special concatenation process to designate where the boundaries
-- are between the original, un-concatenated list of strings. These
-- added whitespace characters are removed from the output.
--
-- > unescapeArgs "hello\\ \\\"world\\\"\n" == escapeArgs "hello \"world\""
unescapeArgs :: String -> [String]
unescapeArgs = filter (not . null) . unescape
-- | Arguments which look like '@foo' will be replaced with the
-- contents of file @foo@. A gcc-like syntax for response files arguments
-- is expected. This must re-constitute the argument list by doing an
-- inverse of the escaping mechanism done by the calling-program side.
--
-- We quit if the file is not found or reading somehow fails.
-- (A convenience routine for haddock or possibly other clients)
expandResponse :: [String] -> IO [String]
expandResponse = fmap concat . mapM expand
where
expand :: String -> IO [String]
expand ('@':f) = readFileExc f >>= return . unescapeArgs
expand x = return [x]
readFileExc f =
readFile f `Control.Exception.catch` \(e :: IOException) -> do
hPutStrLn stderr $ "Error while expanding response file: " ++ show e
exitFailure
data Quoting = NoneQ | SngQ | DblQ
unescape :: String -> [String]
unescape args = reverse . map reverse $ go args NoneQ False [] []
where
-- n.b., the order of these cases matters; these are cribbed from gcc
-- case 1: end of input
go [] _q _bs a as = a:as
-- case 2: back-slash escape in progress
go (c:cs) q True a as = go cs q False (c:a) as
-- case 3: no back-slash escape in progress, but got a back-slash
go (c:cs) q False a as
| '\\' == c = go cs q True a as
-- case 4: single-quote escaping in progress
go (c:cs) SngQ False a as
| '\'' == c = go cs NoneQ False a as
| otherwise = go cs SngQ False (c:a) as
-- case 5: double-quote escaping in progress
go (c:cs) DblQ False a as
| '"' == c = go cs NoneQ False a as
| otherwise = go cs DblQ False (c:a) as
-- case 6: no escaping is in progress
go (c:cs) NoneQ False a as
| isSpace c = go cs NoneQ False [] (a:as)
| '\'' == c = go cs SngQ False a as
| '"' == c = go cs DblQ False a as
| otherwise = go cs NoneQ False (c:a) as
#endif
......@@ -44,13 +44,9 @@ import Data.Version ( showVersion )
import System.Environment ( getExecutablePath )
import System.FilePath ( takeDirectory, (</>) )
#endif
#if MIN_VERSION_base(4,12,0)
import GHC.ResponseFile ( getArgsWithResponseFiles )
#else
import System.Environment ( getArgs )
#endif
import Common
import Compat.ResponseFile ( getArgsWithResponseFiles )
import CrossCodegen
import DirectCodegen
import Flags
......@@ -79,11 +75,7 @@ main = do
prog <- getProgramName
let header = "Usage: "++prog++" [OPTIONS] INPUT.hsc [...]\n"
usage = usageInfo header options
#if MIN_VERSION_base(4,12,0)
args <- getArgsWithResponseFiles
#else
args <- getArgs
#endif
let (fs, files, errs) = getOpt Permute options args
let mode = foldl (.) id fs emptyMode
case mode of
......
## 0.68.4.1
- Support response files regardless of which GHC `hsc2hs` was compiled
with ([#15758](https://ghc.haskell.org/trac/ghc/ticket/15758))
## 0.68.4
- Add support to read command line arguments supplied via response files
......
cabal-version: >=1.10
Name: hsc2hs
Version: 0.68.4
Version: 0.68.4.1
Copyright: 2000, Marcin Kowalczyk
License: BSD3
......@@ -51,6 +51,7 @@ Executable hsc2hs
HSCParser
ATTParser
UtilsCodegen
Compat.ResponseFile
Paths_hsc2hs
Other-Extensions: CPP, NoMonomorphismRestriction
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment