-{-# OPTIONS -cpp -fffi #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
#if __GLASGOW_HASKELL__ < 603
#include "config.h"
#else
import Data.List
import System.Exit
import Data.Char
-
-#ifdef USING_COMPAT
-import Compat.RawSystem ( rawSystem )
-import Compat.Directory ( findExecutable )
-#else
+import System.Directory ( removeFile )
+import Control.Exception ( bracket )
+import System.Directory ( findExecutable, getTemporaryDirectory )
import System.Cmd ( rawSystem )
-import System.Directory ( findExecutable )
-#endif
main :: IO ()
main = do
doIt ghc args = do
let (ghc_args, rest) = getGhcArgs args
case rest of
- [] -> dieProg usage
+ [] -> do
+ -- behave like typical perl, python, ruby interpreters:
+ -- read from stdin
+ tmpdir <- getTemporaryDirectory
+ bracket
+ (openTempFile tmpdir "runghcXXXX.hs")
+ (\(filename,_) -> removeFile filename)
+ $ \(filename,h) -> do
+ getContents >>= hPutStr h
+ hClose h
+ doIt ghc (ghc_args ++ [filename])
filename : prog_args -> do
- let expr = "System.Environment.withProgName " ++ show filename ++
- " (System.Environment.withArgs " ++ show prog_args ++
- " (GHC.TopHandler.runIOFastExit" ++
- " (Main.main Prelude.>> Prelude.return ())))"
+ let c1 = ":set prog " ++ show filename
+ c2 = ":main " ++ show prog_args
res <- rawSystem ghc (["-ignore-dot-ghci"] ++ ghc_args ++
- [ "-e", expr, filename])
- -- runIOFastExit: makes exceptions raised by Main.main
- -- behave in the same way as for a compiled program.
- -- The "fast exit" part just calls exit() directly
- -- instead of doing an orderly runtime shutdown,
- -- otherwise the main GHCi thread will complain about
- -- being interrupted.
- --
- -- Why (main >> return ()) rather than just main? Because
- -- otherwise GHCi by default tries to evaluate the result
- -- of the IO in order to show it (see #1200).
+ [ "-e", c1, "-e", c2, filename])
exitWith res
getGhcArgs :: [String] -> ([String], [String])
-getGhcArgs args = case break pastArgs args of
- (xs, "--":ys) -> (xs, ys)
- (xs, ys) -> (xs, ys)
+getGhcArgs args
+ = let (ghcArgs, otherArgs) = case break pastArgs args of
+ (xs, "--":ys) -> (xs, ys)
+ (xs, ys) -> (xs, ys)
+ in (map unescape ghcArgs, otherArgs)
+ where unescape ('-':'-':'g':'h':'c':'-':'a':'r':'g':'=':arg) = arg
+ unescape arg = arg
pastArgs :: String -> Bool
--- You can use -- to mark the end of the flags, in caes you need to use
+-- You can use -- to mark the end of the flags, in case you need to use
-- a file called -foo.hs for some reason. You almost certainly shouldn't,
-- though.
pastArgs "--" = True
hPutStrLn stderr (p ++ ": " ++ msg)
exitWith (ExitFailure 1)
-usage :: String
-usage = "syntax: runghc [-f GHC-PATH | --] [GHC-ARGS] [--] FILE ARG..."
+-- usage :: String
+-- usage = "syntax: runghc [-f GHC-PATH | --] [GHC-ARGS] [--] FILE ARG..."