Commit 0a066666 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Make the runghc code prettier and fix some warnings

parent d8e15453
......@@ -11,16 +11,16 @@
-- runghc program, for invoking from a #! line in a script. For example:
--
-- script.lhs:
-- #! /usr/bin/runghc
-- > main = putStrLn "hello!"
-- #! /usr/bin/runghc
-- > main = putStrLn "hello!"
--
-- runghc accepts one flag:
--
-- -f <path> specify the path
-- -f <path> specify the path
--
-- -----------------------------------------------------------------------------
module Main where
module Main (main) where
import System.Environment
import System.IO
......@@ -36,31 +36,32 @@ import System.Cmd ( rawSystem )
import System.Directory ( findExecutable )
#endif
main = do
args <- getArgs
case args of
("-f" : ghc : args) -> do
doIt ghc args
('-':'f' : ghc) : args -> do
doIt (dropWhile isSpace ghc) args
args -> do
mb_ghc <- findExecutable "ghc"
case mb_ghc of
Nothing -> dieProg ("cannot find ghc")
Just ghc -> doIt ghc args
main :: IO ()
main = do
args <- getArgs
case args of
("-f" : ghc : args) -> do
doIt ghc args
('-' : 'f' : ghc) : args -> do
doIt (dropWhile isSpace ghc) args
_ -> do
mb_ghc <- findExecutable "ghc"
case mb_ghc of
Nothing -> dieProg ("cannot find ghc")
Just ghc -> doIt ghc args
doIt :: String -> [String] -> IO ()
doIt ghc args = do
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 Prelude.>> (Prelude.return ()))))", filename])
let (ghc_args, rest) = break notArg args
case rest of
[] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
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 ())))"
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
......@@ -71,13 +72,15 @@ doIt ghc args = do
-- 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).
exitWith res
exitWith res
notArg :: String -> Bool
notArg ('-':_) = False
notArg _ = True
dieProg :: String -> IO a
dieProg msg = do
p <- getProgName
hPutStrLn stderr (p ++ ": " ++ msg)
exitWith (ExitFailure 1)
p <- getProgName
hPutStrLn stderr (p ++ ": " ++ msg)
exitWith (ExitFailure 1)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment