diff options
| -rw-r--r-- | CHANGES.md | 3 | ||||
| -rw-r--r-- | driver-test/Main.hs | 12 | ||||
| -rw-r--r-- | driver-test/ResponseFileSpec.hs | 80 | ||||
| -rw-r--r-- | driver/Main.hs | 5 | ||||
| -rw-r--r-- | driver/ResponseFile.hs | 110 | ||||
| -rw-r--r-- | haddock.cabal | 17 |
6 files changed, 5 insertions, 222 deletions
@@ -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 |