utils/runghc/runghc.hs

   1 {-# OPTIONS -cpp -fffi #-}
   2 #if __GLASGOW_HASKELL__ < 603
   3 #include "config.h"
   4 #else
   5 #include "ghcconfig.h"
   6 #endif
   7 -----------------------------------------------------------------------------
   8 --
   9 -- (c) The University of Glasgow, 2004
  10 --
  11 -- runghc program, for invoking from a #! line in a script.  For example:
  12 --
  13 --   script.lhs:
  14 --      #! /usr/bin/runghc
  15 --      > main = putStrLn "hello!"
  16 --
  17 -- runghc accepts one flag:
  18 --
  19 --      -f <path>    specify the path
  20 --
  21 -- -----------------------------------------------------------------------------
  22
  23 module Main (main) where
  24
  25 import System.Environment
  26 import System.IO
  27 import Data.List
  28 import System.Exit
  29 import Data.Char
  30
  31 #ifdef USING_COMPAT
  32 import Compat.RawSystem ( rawSystem )
  33 import Compat.Directory ( findExecutable )
  34 #else
  35 import System.Cmd       ( rawSystem )
  36 import System.Directory ( findExecutable )
  37 #endif
  38
  39 main :: IO ()
  40 main = do
  41     args <- getArgs
  42     case args of
  43         ("-f" : ghc : args) -> do
  44             doIt ghc args
  45         ('-' : 'f' : ghc) : args -> do
  46             doIt (dropWhile isSpace ghc) args
  47         _ -> do
  48             mb_ghc <- findExecutable "ghc"
  49             case mb_ghc of
  50                 Nothing  -> dieProg ("cannot find ghc")
  51                 Just ghc -> doIt ghc args
  52
  53 doIt :: String -> [String] -> IO ()
  54 doIt ghc args = do
  55     let (ghc_args, rest) = break notArg args
  56     case rest of
  57         [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
  58         filename : prog_args -> do
  59             let expr = "System.Environment.withProgName " ++ show filename ++
  60                        " (System.Environment.withArgs " ++ show prog_args ++
  61                        " (GHC.TopHandler.runIOFastExit" ++
  62                        " (Main.main Prelude.>> Prelude.return ())))"
  63             res <- rawSystem ghc (["-ignore-dot-ghci"] ++ ghc_args ++
  64                                   [ "-e", expr, filename])
  65                -- runIOFastExit: makes exceptions raised by Main.main
  66                -- behave in the same way as for a compiled program.
  67                -- The "fast exit" part just calls exit() directly
  68                -- instead of doing an orderly runtime shutdown,
  69                -- otherwise the main GHCi thread will complain about
  70                -- being interrupted.
  71                --
  72                -- Why (main >> return ()) rather than just main?  Because
  73                -- otherwise GHCi by default tries to evaluate the result
  74                -- of the IO in order to show it (see #1200).
  75             exitWith res
  76
  77 notArg :: String -> Bool
  78 notArg ('-':_) = False
  79 notArg _       = True
  80
  81 dieProg :: String -> IO a
  82 dieProg msg = do
  83     p <- getProgName
  84     hPutStrLn stderr (p ++ ": " ++ msg)
  85     exitWith (ExitFailure 1)
  86