1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
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
|
