-{-# OPTIONS -fffi -cpp #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
------------------------------------------------------------------------
-- Program for converting .hsc files to .hs files, by converting the
import Monad (MonadPlus(..), liftM, liftM2, when)
import Char (isAlpha, isAlphaNum, isSpace, isDigit, toUpper, intToDigit, ord)
import List (intersperse, isSuffixOf)
-import IO (hPutStr, hPutStrLn, stderr)
+import IO (hPutStr, hPutStrLn, stderr, bracket_)
#if defined(mingw32_HOST_OS)
import Foreign
#endif
#if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC)
-import Compat.RawSystem ( rawSystem )
+import System.Cmd ( rawSystem )
#define HAVE_rawSystem
#elif __NHC__ >= 117
import System.Cmd ( rawSystem )
-- to find one by looking near the executable. This only
-- works on Win32 or Hugs (getExecDir). On Unix, there's a wrapper
-- script which specifies an explicit template flag.
- flags_w_tpl <- if any template_flag flags then
+ flags_w_tpl0 <- if any template_flag flags then
return flags
else
do mb_path <- getExecDir "/bin/hsc2hs.exe"
then return ((Template templ):)
else return id
return (add_opt flags)
+
+ -- take only the last --template flag on the cmd line
+ let
+ (before,tpl:after) = break template_flag (reverse flags_w_tpl0)
+ flags_w_tpl = reverse (before ++ tpl : filter (not.template_flag) after)
+
case (files, errs) of
(_, _)
| any isHelp flags_w_tpl -> bye (usageInfo header options)
++ [cProgName]
++ ["-o", oProgName]
)
- removeFile cProgName
+ finallyRemove cProgName $ do
rawSystemL ("linking " ++ oProgName) beVerbose linker
( [f | LinkFlag f <- flags]
++ [oProgName]
++ ["-o", progName]
)
- removeFile oProgName
+ finallyRemove oProgName $ do
rawSystemWithStdOutL ("running " ++ execProgName) beVerbose execProgName [] outName
- removeFile progName
+ finallyRemove progName $ do
when needsH $ writeFile outHName $
"#ifndef "++includeGuard++"\n" ++
ExitFailure _ -> die $ action ++ " failed\ncommand was: " ++ cmdLine ++ "\n"
_ -> return ()
+
+-- delay the cleanup of generated files until the end; attempts to
+-- get around intermittent failure to delete files which has
+-- just been exec'ed by a sub-process (Win32 only.)
+finallyRemove :: FilePath -> IO a -> IO a
+finallyRemove fp act =
+ bracket_ (return fp)
+ (const $ noisyRemove fp)
+ act
+ where
+ noisyRemove fpath =
+ catch (removeFile fpath)
+ (\ e -> hPutStrLn stderr ("Failed to remove file " ++ fpath ++ "; error= " ++ show e))
onlyOne :: String -> IO a
onlyOne what = die ("Only one "++what++" may be specified\n")