Make the runghc code prettier and fix some warnings
authorIan Lynagh <igloo@earth.li>
Sat, 18 Aug 2007 22:40:21 +0000 (22:40 +0000)
committerIan Lynagh <igloo@earth.li>
Sat, 18 Aug 2007 22:40:21 +0000 (22:40 +0000)
utils/runghc/runghc.hs

index 6896a68..9346390 100644 (file)
 -- 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)
+