- let
- (ghc_args, rest) = break notArg args
- --
- case rest of
- [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
- filename : prog_args -> do
- res <- rawSystem ghc (
- "-ignore-dot-ghci" : ghc_args ++
- [ "-e","System.Environment.withProgName "++show filename++" (System.Environment.withArgs ["
- ++ concat (intersperse "," (map show prog_args))
- ++ "] (GHC.TopHandler.runIOFastExit Main.main))", 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.
- exitWith res
-
-notArg ('-':_) = False
-notArg _ = True
+ let (ghc_args, rest) = getGhcArgs args
+ case rest of
+ [] -> do
+ -- behave like typical perl, python, ruby interpreters:
+ -- read from stdin
+ tmpdir <- getTemporaryDirectory
+ bracket
+ (openTempFile tmpdir "runghcXXXX.hs")
+ (\(filename,h) -> do hClose h; removeFile filename)
+ $ \(filename,h) -> do
+ getContents >>= hPutStr h
+ hClose h
+ doIt ghc (ghc_args ++ [filename])
+ filename : prog_args -> do
+ -- If the file exists, and is not a .lhs file, then we
+ -- want to treat it as a .hs file.
+ --
+ -- If the file doesn't exist then GHC is going to look for
+ -- filename.hs and filename.lhs, and use the appropriate
+ -- type.
+ exists <- doesFileExist filename
+ let xflag = if exists && (takeExtension filename /= ".lhs")
+ then ["-x", "hs"]
+ else []
+ c1 = ":set prog " ++ show filename
+ c2 = ":main " ++ show prog_args
+ res <- rawSystem ghc (["-ignore-dot-ghci"] ++
+ xflag ++
+ ghc_args ++
+ [ "-e", c1, "-e", c2, filename])
+ exitWith res
+
+getGhcArgs :: [String] -> ([String], [String])
+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 case you need to use
+-- a file called -foo.hs for some reason. You almost certainly shouldn't,
+-- though.
+pastArgs "--" = True
+pastArgs ('-':_) = False
+pastArgs _ = True