ghc/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 import Compat.RawSystem         ( rawSystem )
  32 import Compat.Directory         ( findExecutable )
  33
  34 main = do
  35   args <- getArgs
  36   case args of
  37     ('-':'f' : ghc) : filename : args -> do
  38         doIt (dropWhile isSpace ghc) filename args
  39     filename : args -> do
  40         mb_ghc <- findExecutable "ghc"
  41         case mb_ghc of
  42           Nothing  -> dieProg ("cannot find ghc")
  43           Just ghc -> doIt ghc filename args
  44     _other -> do
  45         dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
  46
  47 doIt ghc filename args = do
  48   res <- rawSystem ghc ["-e","System.Environment.withArgs ["
  49                         ++ concat (intersperse "," (map show args))
  50                         ++ "] Main.main", filename]
  51   exitWith res
  52
  53 dieProg :: String -> IO a
  54 dieProg msg = do
  55   p <- getProgName
  56   hPutStr stderr (p ++ ": " ++ msg)
  57   exitWith (ExitFailure 1)