-runSomething phase_name pgm args
- = traceCmd phase_name (concat (intersperse " " (pgm:quoteargs))) $
- do
-#ifdef mingw32_HOST_OS
- let showOptions :: [Option] -> String
- showOptions ls = unwords (map (quote . showOpt) ls)
-
- quote :: String -> String
- quote "" = ""
- quote s = "\"" ++ escapeDoubleQuotes s ++ "\""
-
- escapeDoubleQuotes :: String -> String
- escapeDoubleQuotes "" = ""
- escapeDoubleQuotes ('\\':'"':cs) = '\\':'"':escapeDoubleQuotes cs
- escapeDoubleQuotes ( '"':cs) = '\\':'"':escapeDoubleQuotes cs
- escapeDoubleQuotes (c :cs) = c :escapeDoubleQuotes cs
-
- -- The pgm is already in native format (appropriate dir separators)
- exit_code <- rawSystem (pgm ++ ' ':showOptions args)
-#else
- mpid <- forkProcess
- exit_code <- case mpid of
- Nothing -> do -- Child
- executeFile pgm True quoteargs Nothing
- exitWith (ExitFailure 127)
- -- NOT REACHED
- return ExitSuccess
- Just child -> do -- Parent
-#if __GLASGOW_HASKELL__ <= 504
- -- avoid interaction with broken getProcessStatus-FFI:
- oldHandler <- installHandler sigCONT Ignore Nothing
-#endif
- Just (Exited res) <- getProcessStatus True False child
-#if __GLASGOW_HASKELL__ <= 504
- -- restore handler
- installHandler sigCONT oldHandler Nothing
-#endif
-
- return res
-#endif
- when (exit_code /= ExitSuccess) $
- throwDyn (PhaseFailed phase_name exit_code)
- return ()
- where
- quoteargs = filter (not . null) (map showOpt args)
+runSomething phase_name pgm args = do
+ let real_args = filter notNull (map showOpt args)
+ traceCmd phase_name (unwords (pgm:real_args)) $ do
+ exit_code <- rawSystem pgm real_args
+ case exit_code of
+ ExitSuccess ->
+ return ()
+ -- rawSystem returns (ExitFailure 127) if the exec failed for any
+ -- reason (eg. the program doesn't exist). This is the only clue
+ -- we have, but we need to report something to the user because in
+ -- the case of a missing program there will otherwise be no output
+ -- at all.
+ ExitFailure 127 ->
+ throwDyn (InstallationError ("could not execute: " ++ pgm))
+ ExitFailure _other ->
+ throwDyn (PhaseFailed phase_name exit_code)