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 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 = do
  40   args <- getArgs
  41   case args of
  42     ('-':'f' : ghc) : args -> do
  43         doIt (dropWhile isSpace ghc) args
  44     args -> do
  45         mb_ghc <- findExecutable "ghc"
  46         case mb_ghc of
  47           Nothing  -> dieProg ("cannot find ghc")
  48           Just ghc -> doIt ghc args
  49
  50 doIt ghc args = do
  51   let
  52     (ghc_args, rest) = break notArg args
  53   --
  54   case rest of
  55      [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
  56      filename : prog_args -> do
  57           res <- rawSystem ghc (
  58                         "-ignore-dot-ghci" : ghc_args ++
  59                         [ "-e","System.Environment.withProgName "++show filename++" (System.Environment.withArgs ["
  60                           ++ concat (intersperse "," (map show prog_args))
  61                           ++ "] (GHC.TopHandler.runIOFastExit Main.main))", filename])
  62                -- runIOFastExit: makes exceptions raised by Main.main
  63                -- behave in the same way as for a compiled program.
  64                -- The "fast exit" part just calls exit() directly
  65                -- instead of doing an orderly runtime shutdown,
  66                -- otherwise the main GHCi thread will complain about
  67                -- being interrupted.
  68           exitWith res
  69
  70 notArg ('-':_) = False
  71 notArg _       = True
  72
  73 dieProg :: String -> IO a
  74 dieProg msg = do
  75   p <- getProgName
  76   hPutStrLn stderr (p ++ ": " ++ msg)
  77   exitWith (ExitFailure 1)