aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2016-01-06 14:35:00 +0100
committerBen Gamari <ben@smart-cactus.org>2016-01-06 14:35:00 +0100
commita13d21c688cae176be4505a5a6e9d64739845ea3 (patch)
treeb46e2ca15cf3ca46bd2ce0ab2329e9969608667c
parent6ddd758be0e7b50bd19d33400b3c3013d60786cb (diff)
parent13e1eaf3ca897ffcf1b37d96e2867bc80d4ca64a (diff)
Merge branch 'master' into ghc-head
-rw-r--r--CHANGES12
-rw-r--r--driver-test/Main.hs12
-rw-r--r--driver-test/ResponseFileSpec.hs80
-rw-r--r--driver/Main.hs23
-rw-r--r--driver/ResponseFile.hs110
-rw-r--r--haddock-api/haddock-api.cabal2
-rw-r--r--haddock-api/src/Haddock/InterfaceFile.hs2
-rw-r--r--haddock-library/haddock-library.cabal2
-rw-r--r--haddock.cabal11
9 files changed, 228 insertions, 26 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/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-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 1bc4ddb3..770b9977 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__ >= 801) && (__GLASGOW_HASKELL__ < 803)
-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 f3c20f43..d2b1df3b 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
@@ -65,6 +65,8 @@ executable haddock
transformers
other-modules:
+ ResponseFile,
+
Documentation.Haddock.Parser
Documentation.Haddock.Parser.Monad
Documentation.Haddock.Types
@@ -123,6 +125,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