-- 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
import System.Directory ( findExecutable )
#endif
-main = do
- args <- getArgs
- case args of
- ('-':'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 getGhcLoc args of
+ (Just ghc, args') -> doIt ghc args'
+ (Nothing, args') -> do
+ mb_ghc <- findExecutable "ghc"
+ case mb_ghc of
+ Nothing -> dieProg ("cannot find ghc")
+ Just ghc -> doIt ghc args'
+getGhcLoc :: [String] -> (Maybe FilePath, [String])
+getGhcLoc ("-f" : ghc : args) = (Just ghc, args)
+getGhcLoc (('-' : 'f' : ghc) : args) = (Just ghc, args)
+-- If you need the first GHC flag to be a -f flag then you can pass --
+-- first
+getGhcLoc ("--" : args) = (Nothing, args)
+getGhcLoc args = (Nothing, 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) = getGhcArgs args
+ case rest of
+ [] -> dieProg usage
+ 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
-- 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
+
+getGhcArgs :: [String] -> ([String], [String])
+getGhcArgs args = case break pastArgs args of
+ (xs, "--":ys) -> (xs, ys)
+ (xs, ys) -> (xs, ys)
-notArg ('-':_) = False
-notArg _ = True
+pastArgs :: String -> Bool
+-- You can use -- to mark the end of the flags, in caes you need to use
+-- a file called -foo.hs for some reason. You almost certainly shouldn't,
+-- though.
+pastArgs "--" = True
+pastArgs ('-':_) = False
+pastArgs _ = 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)
+
+usage :: String
+usage = "syntax: runghc [-f GHC-PATH | --] [GHC-ARGS] [--] FILE ARG..."
+