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

Compat/ResponseFile.hs

@@ -0,0 +1,118 @@
+{-# 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

Main.hs

@@ -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

changelog.md

@@ -1,3 +1,8 @@
+## 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

hsc2hs.cabal

@@ -1,6 +1,6 @@
 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