From d510c45790432249fe7027b1ed70ce1c06fdd824 Mon Sep 17 00:00:00 2001 From: randen Date: Fri, 1 Jan 2016 18:02:11 -0800 Subject: The Haddock part for fully gcc-like response files " driver/Main.hs * Moved the response file handling into ResponseFile.hs, updating import section as appropriate. * driver/ResponseFile.hs * New file. In anticipation that maybe some day this could be provided by another library, and to make it possible to unit test, this functionality is pulled out of the Main.hs module, and expanded to support the style/format of response files which gcc uses. * The specification for the format of response files which gcc generates and consumes, seems to be best derived from the gcc code itself (libiberty/argv.c), so that is what has been done here. * This is intended to fix haskell/haddock#379 * driver-test/Main.hs * New file for testing code in the driver source tree * driver-test/ResponseFileSpec.hs * Tests, adapted/adopted from the same gcc code where the escaping/unescaping is from, in the hspec style of unit tests * haddock.cabal * Add the driver-test test-suite. Introduces a new library dependency (upon hspec) for the haddock driver target in the haddock.cabal file, but practically, this should not be a problem as the haddock-api tests already depend on hspec. --- driver-test/Main.hs | 12 +++++ driver-test/ResponseFileSpec.hs | 80 +++++++++++++++++++++++++++++ driver/Main.hs | 23 +-------- driver/ResponseFile.hs | 110 ++++++++++++++++++++++++++++++++++++++++ haddock.cabal | 7 +++ 5 files changed, 210 insertions(+), 22 deletions(-) create mode 100644 driver-test/Main.hs create mode 100644 driver-test/ResponseFileSpec.hs create mode 100644 driver/ResponseFile.hs diff --git a/driver-test/Main.hs b/driver-test/Main.hs new file mode 100644 index 00000000..d3f636e9 --- /dev/null +++ b/driver-test/Main.hs @@ -0,0 +1,12 @@ +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 new file mode 100644 index 00000000..997adac4 --- /dev/null +++ b/driver-test/ResponseFileSpec.hs @@ -0,0 +1,80 @@ +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 ccbb8b7d..852f44c7 100644 --- a/driver/Main.hs +++ b/driver/Main.hs @@ -1,29 +1,8 @@ -{-# LANGUAGE ScopedTypeVariables #-} module Main where -import Control.Exception import Documentation.Haddock (haddock) +import ResponseFile (expandResponse) import System.Environment (getArgs) -import System.Exit (exitFailure) -import System.IO main :: IO () main = getArgs >>= expandResponse >>= haddock - - --- | Arguments which look like '@foo' will be replaced with the --- contents of file @foo@. The contents will be passed through 'words' --- and blanks filtered out first. --- --- We quit if the file is not found or reading somehow fails. -expandResponse :: [String] -> IO [String] -expandResponse = fmap concat . mapM expand - where - expand :: String -> IO [String] - expand ('@':f) = readFileExc f >>= return . filter (not . null) . lines - expand x = return [x] - - readFileExc f = - readFile f `catch` \(e :: IOException) -> do - hPutStrLn stderr $ "Error while expanding response file: " ++ show e - exitFailure diff --git a/driver/ResponseFile.hs b/driver/ResponseFile.hs new file mode 100644 index 00000000..253c6004 --- /dev/null +++ b/driver/ResponseFile.hs @@ -0,0 +1,110 @@ +{-# 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 71b78347..5fbfa3a0 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -122,6 +122,13 @@ executable haddock else build-depends: haddock-api == 2.16.* +test-suite driver-test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: driver-test, driver + build-depends: base, hspec + test-suite html-test type: exitcode-stdio-1.0 default-language: Haskell2010 -- cgit v1.2.3 From 116e56e201e2efb52e9ade07deecbcf5f3106719 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Wed, 6 Jan 2016 13:37:54 +0100 Subject: Version bumps and changelog --- CHANGES | 12 ++++++++++++ haddock-api/haddock-api.cabal | 2 +- haddock-api/src/Haddock/InterfaceFile.hs | 2 +- haddock-library/haddock-library.cabal | 2 +- haddock.cabal | 2 +- 5 files changed, 16 insertions(+), 4 deletions(-) diff --git a/CHANGES b/CHANGES index 2cb0a5e0..f3b90e98 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,15 @@ +Changes in version 2.17.0 + + * Included with GHC 8.0.1 + + * Support typesetting of mathematical expressions via Mathjax (#397) + + * Describe orphan instances defined in a module in its documentation (#449) + + * Produce specialized type signatures for typeclass methods (#425) + + * Support GCC-like response files (#470) + Changes in version 2.16.2 * Generate hyperlinked source ourselves (#410, part of GSOC 2015) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 7835ea50..e1e7480f 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,5 +1,5 @@ name: haddock-api -version: 2.16.2 +version: 2.17.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 5d15fb33..f45589a0 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -82,7 +82,7 @@ binaryInterfaceMagic = 0xD0Cface -- binaryInterfaceVersion :: Word16 #if (__GLASGOW_HASKELL__ >= 711) && (__GLASGOW_HASKELL__ < 801) -binaryInterfaceVersion = 27 +binaryInterfaceVersion = 28 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index f60501f5..e7dd68a3 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.2.1 +version: 1.4.0 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it diff --git a/haddock.cabal b/haddock.cabal index 007d71d5..2ada188d 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.16.2 +version: 2.17.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries -- cgit v1.2.3 From 13e1eaf3ca897ffcf1b37d96e2867bc80d4ca64a Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Wed, 6 Jan 2016 08:14:42 -0500 Subject: Add ResponseFile to OtherModules --- haddock.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/haddock.cabal b/haddock.cabal index 639b6aaf..1d7a9fee 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -65,6 +65,8 @@ executable haddock transformers other-modules: + ResponseFile, + Documentation.Haddock.Parser Documentation.Haddock.Parser.Monad Documentation.Haddock.Types -- cgit v1.2.3