From 0a066666b10008aca3a875f5c7499c21c59efc0c Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sat, 18 Aug 2007 22:40:21 +0000
Subject: [PATCH] Make the runghc code prettier and fix some warnings

---
 utils/runghc/runghc.hs |   65 +++++++++++++++++++++++++-----------------------
 1 file changed, 34 insertions(+), 31 deletions(-)

diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs
index 6896a68..9346390 100644
--- a/utils/runghc/runghc.hs
+++ b/utils/runghc/runghc.hs
@@ -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)
+
-- 
1.7.10.4