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
111
112
113
114
115
116
117
118
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- taken from base-4.12.0.0's "GHC.ResponseFile"
module Compat.ResponseFile ( getArgsWithResponseFiles ) where
#if MIN_VERSION_base(4,12,0)
import GHC.ResponseFile (getArgsWithResponseFiles)
#else
import Control.Exception
import Data.Char (isSpace)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO
{-|
Like 'getArgs', but can also read arguments supplied via response files.
For example, consider a program @foo@:
@
main :: IO ()
main = do
args <- getArgsWithResponseFiles
putStrLn (show args)
@
And a response file @args.txt@:
@
--one 1
--'two' 2
--"three" 3
@
Then the result of invoking @foo@ with @args.txt@ is:
> > ./foo @args.txt
> ["--one","1","--two","2","--three","3"]
-}
getArgsWithResponseFiles :: IO [String]
getArgsWithResponseFiles = getArgs >>= expandResponse
-- | 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
-- | 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 `Control.Exception.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
#endif
|
