Move the ResponseFile module from haddock into base

GHC and the build tools use "response files" to work around the limit
on the length of command line arguments on Windows. Haddock's
implementation of parsing response files (i.e escaping/unescaping the
appropriate characters) seems complete, is well tested, and also
closely matches the GCC version. This patch moves the relevant bits
into `base` so that it's easier for other libraries to reuse it.

Test Plan: make test TEST=T13896

Reviewers: bgamari, RyanGlScott, 23Skidoo, hvr

Reviewed By: RyanGlScott

Subscribers: thomie, carter

GHC Trac Issues: #13896

Differential Revision: https://phabricator.haskell.org/D4612

2 files changed, 76 insertions, 0 deletions

diff --git a/libraries/base/tests/T13896.hs b/libraries/base/tests/T13896.hs
new file mode 100644
index 0000000000..9e269a4a7c
--- /dev/null
+++ b/libraries/base/tests/T13896.hs
@@ -0,0 +1,75 @@
+import GHC.ResponseFile
+
+assertEqual :: (Eq a, Show a) => a -> a -> IO ()
+assertEqual x y = if x == y
+                  then return ()
+                  else error $ "assertEqual: " ++ show x ++ " /= " ++ show y
+
+-- Migrated from Haddock.
+
+-- 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")
+  ]
+
+main :: IO ()
+main = do
+  -- Test escapeArgs
+  mapM_ (\((ss1,s2),des) -> escapeArgs ss1 `assertEqual` s2) testStrs
+
+  -- Test unescapeArgs
+  mapM_ (\((ss1,s2),des) -> unescapeArgs s2 `assertEqual` ss1) testStrs
+
+  -- Given unescaped quotes, it should pass-through,
+  -- without escaping everything inside
+
+  (filter (not . null) $
+   unescapeArgs "this\\ is\\ 'not escape\\d \"inside\"'\\ yo\n")
+   `assertEqual`
+   ["this is not escaped \"inside\" yo"]
+
+  (filter (not . null) $
+   unescapeArgs "this\\ is\\ \"not escape\\d 'inside'\"\\ yo\n")
+   `assertEqual`
+   ["this is not escaped 'inside' yo"]
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 0db147ea1e..491df2fd7e 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -223,3 +223,4 @@ test('T3474',
      compile_and_run, ['-O'])
 test('T14425', normal, compile_and_run, [''])
 test('T10412', normal, compile_and_run, [''])
+test('T13896', normal, compile_and_run, [''])