Use the response file utilities defined in `base` (#821)

Summary: The response file related modules were recently copied from
`haddock` into `base`. This patch removes them from `haddock`.

GHC Trac Issues: #13896

6 files changed, 5 insertions, 222 deletions

diff --git a/CHANGES.md b/CHANGES.md
index 9ba8be07..ad0a86fb 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -25,6 +25,9 @@
  * Overhaul handling of data declarations in XHTML and LaTeX. Adds support for
    documenting individual arguments of constructors/patterns (#709)
 
+ * Remove the response file related utilities, and use the ones that
+   come with `base` (Trac #13896)
+
 ## Changes in version 2.18.1
 
  * Synopsis is working again (#599)
diff --git a/driver-test/Main.hs b/driver-test/Main.hs
deleted file mode 100644
index d3f636e9..00000000
--- a/driver-test/Main.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Main where
-
-import Test.Hspec (describe, hspec, Spec)
-import qualified ResponseFileSpec (spec)
-
-
-main :: IO ()
-main = hspec spec
-
-spec :: Spec
-spec = do
-    describe "ResponseFile" ResponseFileSpec.spec
diff --git a/driver-test/ResponseFileSpec.hs b/driver-test/ResponseFileSpec.hs
deleted file mode 100644
index 997adac4..00000000
--- a/driver-test/ResponseFileSpec.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-module ResponseFileSpec where
-
-import Test.Hspec (context, describe, it, shouldBe, Spec)
-import ResponseFile (escapeArgs, unescapeArgs)
-
--- The first two elements are
---   1) a list of 'args' to encode and
---   2) a single string of the encoded args
--- The 3rd element is just a description for the tests.
-testStrs :: [(([String], String), String)]
-testStrs =
-  [ ((["a simple command line"],
-      "a\\ simple\\ command\\ line\n"),
-     "the white-space, end with newline")
-
-  , ((["arg 'foo' is single quoted"],
-      "arg\\ \\'foo\\'\\ is\\ single\\ quoted\n"),
-     "the single quotes as well")
-
-  , ((["arg \"bar\" is double quoted"],
-      "arg\\ \\\"bar\\\"\\ is\\ double\\ quoted\n"),
-     "the double quotes as well" )
-
-  , ((["arg \"foo bar\" has embedded whitespace"],
-      "arg\\ \\\"foo\\ bar\\\"\\ has\\ embedded\\ whitespace\n"),
-     "the quote-embedded whitespace")
-
-  , ((["arg 'Jack said \\'hi\\'' has single quotes"],
-      "arg\\ \\'Jack\\ said\\ \\\\\\'hi\\\\\\'\\'\\ has\\ single\\ quotes\n"),
-     "the escaped single quotes")
-
-  , ((["arg 'Jack said \\\"hi\\\"' has double quotes"],
-      "arg\\ \\'Jack\\ said\\ \\\\\\\"hi\\\\\\\"\\'\\ has\\ double\\ quotes\n"),
-     "the escaped double quotes")
-
-  , ((["arg 'Jack said\\r\\n\\t \\\"hi\\\"' has other whitespace"],
-      "arg\\ \\'Jack\\ said\\\\r\\\\n\\\\t\\ \\\\\\\"hi\\\\\\\"\\'\\ has\\ \
-           \other\\ whitespace\n"),
-     "the other whitespace")
-
-  , (([ "--prologue=.\\dist\\.\\haddock-prologue3239114604.txt"
-      , "--title=HaddockNewline-0.1.0.0: This has a\n\
-        \newline yo."
-      , "-BC:\\Program Files\\Haskell Platform\\lib"],
-      "--prologue=.\\\\dist\\\\.\\\\haddock-prologue3239114604.txt\n\
-      \--title=HaddockNewline-0.1.0.0:\\ This\\ has\\ a\\\n\
-      \newline\\ yo.\n\
-      \-BC:\\\\Program\\ Files\\\\Haskell\\ Platform\\\\lib\n"),
-     "an actual haddock response file snippet with embedded newlines")
-  ]
-
-spec :: Spec
-spec = do
-  describe "escapeArgs" $ do
-      mapM_ (\((ss1,s2),des) -> do
-                  context ("given " ++ (show ss1)) $ do
-                      it ("should escape " ++ des) $ do
-                          escapeArgs ss1 `shouldBe` s2
-            ) testStrs
-  describe "unescapeArgs" $ do
-      mapM_ (\((ss1,s2),des) -> do
-                  context ("given " ++ (show s2)) $ do
-                      it ("should unescape " ++ des) $ do
-                          unescapeArgs s2 `shouldBe` ss1
-            ) testStrs
-  describe "unescapeArgs" $ do
-      context "given unescaped single quotes" $ do
-          it "should pass-through, without escaping, everything inside" $ do
-              -- backslash *always* is escaped anywhere it appears
-              (filter (not . null) $
-                unescapeArgs "this\\ is\\ 'not escape\\d \"inside\"'\\ yo\n")
-              `shouldBe`
-              ["this is not escaped \"inside\" yo"]
-      context "given unescaped double quotes" $ do
-          it "should pass-through, without escaping, everything inside" $ do
-              -- backslash *always* is escaped anywhere it appears
-              (filter (not . null) $
-                unescapeArgs "this\\ is\\ \"not escape\\d 'inside'\"\\ yo\n")
-              `shouldBe`
-              ["this is not escaped 'inside' yo"]
diff --git a/driver/Main.hs b/driver/Main.hs
index 852f44c7..44df4692 100644
--- a/driver/Main.hs
+++ b/driver/Main.hs
@@ -1,8 +1,7 @@
 module Main where
 
 import Documentation.Haddock (haddock)
-import ResponseFile (expandResponse)
-import System.Environment (getArgs)
+import GHC.ResponseFile (getArgsWithResponseFiles)
 
 main :: IO ()
-main = getArgs >>= expandResponse >>= haddock
+main = getArgsWithResponseFiles >>= haddock
diff --git a/driver/ResponseFile.hs b/driver/ResponseFile.hs
deleted file mode 100644
index 253c6004..00000000
--- a/driver/ResponseFile.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-module ResponseFile (
-    unescapeArgs,
-    escapeArgs,
-    expandResponse
-  ) where
-
-import Control.Exception
-import Data.Char (isSpace)
-import Data.Foldable (foldl')
-import System.Exit (exitFailure)
-import System.IO
-
-
--- | 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
-
--- | Given a list of strings, concatenate them into a single string
--- with escaping of certain characters, and the addition of a newline
--- between each string.  The escaping is done by adding a single
--- backslash character before any whitespace, single quote, double
--- quote, or backslash character, so this escaping character must be
--- removed.  Unescaped whitespace (in this case, newline) is part
--- of this "transport" format to indicate the end of the previous
--- string and the start of a new string.
---
--- While 'unescapeArgs' allows using quoting (i.e., convenient
--- escaping of many characters) by having matching sets of single- or
--- double-quotes,'escapeArgs' does not use the quoting mechasnism,
--- and thus will always escape any whitespace, quotes, and
--- backslashes.
---
--- > unescapeArgs "hello\\ \\\"world\\\"\\n" == escapeArgs "hello \"world\""
-escapeArgs :: [String] -> String
-escapeArgs = unlines . map escapeArg
-
--- | 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 `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
-
-escapeArg :: String -> String
-escapeArg = reverse . foldl' escape []
-
-escape :: String -> Char -> String
-escape cs c
-  |    isSpace c
-    || '\\' == c
-    || '\'' == c
-    || '"'  == c = c:'\\':cs -- n.b., our caller must reverse the result
-  | otherwise    = c:cs
diff --git a/haddock.cabal b/haddock.cabal
index c6f241ee..e9280eb2 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -42,7 +42,6 @@ extra-source-files:
   doc/README.md
   doc/*.rst
   doc/conf.py
-  driver-test/*.hs
   haddock-api/src/haddock.sh
   html-test/src/*.hs
   html-test/ref/*.html
@@ -83,8 +82,6 @@ executable haddock
       transformers
 
     other-modules:
-      ResponseFile,
-
       Documentation.Haddock.Parser
       Documentation.Haddock.Parser.Monad
       Documentation.Haddock.Types
@@ -155,20 +152,6 @@ executable haddock
     -- we pin down to a single haddock-api version.
     build-depends:  haddock-api == 2.18.2
 
-    other-modules:
-      ResponseFile
-
-test-suite driver-test
-  type:             exitcode-stdio-1.0
-  default-language: Haskell2010
-  main-is:          Main.hs
-  hs-source-dirs:   driver-test, driver
-  other-modules:
-    ResponseFile
-    ResponseFileSpec
-
-  build-depends:    base, hspec
-
 test-suite html-test
   type:             exitcode-stdio-1.0
   -- This tells cabal that this test depends on the executable