ghc/utils/runghc/runghc.hs

   1 {-# OPTIONS -cpp -fffi #-}
   2 #include "config.h"
   3 -----------------------------------------------------------------------------
   4 --
   5 -- (c) The University of Glasgow, 2004
   6 --
   7 -- runghc program, for invoking from a #! line in a script.  For example:
   8 --
   9 --   script.lhs:
  10 --      #! /usr/bin/runghc
  11 --      > main = putStrLn "hello!"
  12 --
  13 -- runghc accepts one flag:
  14 --
  15 --      -f <path>    specify the path
  16 --
  17 -- -----------------------------------------------------------------------------
  18
  19 module Main where
  20
  21 import System.Environment
  22 import System.IO
  23 import Data.List
  24 import System.Directory
  25 import System.Exit
  26 import Data.Char
  27
  28 #if __GLASGOW_HASKELL__ < 603
  29 import Foreign          ( withMany, withArray0, nullPtr, Ptr )
  30 import Foreign.C        ( CString, withCString, throwErrnoIfMinus1 )
  31 #else
  32 import System.Cmd       ( rawSystem )
  33 #endif
  34
  35 main = do
  36   args <- getArgs
  37   case args of
  38     ('-':'f' : ghc) : filename : args -> do
  39         doIt (dropWhile isSpace ghc) filename args
  40     filename : args -> do
  41         path <- getEnv "PATH" `catch` \e -> return "."
  42         ghc <- findBinary "ghc"
  43         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 findBinary :: String -> IO FilePath
  54 findBinary binary = do
  55   path <- getEnv "PATH"
  56   search (parsePath path)
  57   where
  58     search :: [FilePath] -> IO FilePath
  59     search [] = dieProg ("cannot find " ++ binary)
  60     search (d:ds) = do
  61         let path = d ++ '/':binary
  62         b <- doesFileExist path
  63         if b  then return path else search ds
  64
  65 parsePath :: String -> [FilePath]
  66 parsePath path = split pathSep path
  67   where
  68 #ifdef mingw32_TARGET_OS
  69         pathSep = ';'
  70 #else
  71         pathSep = ':'
  72 #endif
  73
  74 split :: Char -> String -> [String]
  75 split c s = case rest of
  76                 []     -> [chunk]
  77                 _:rest -> chunk : split c rest
  78   where (chunk, rest) = break (==c) s
  79
  80 die :: String -> IO a
  81 die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
  82
  83 dieProg :: String -> IO a
  84 dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg)
  85
  86 #if __GLASGOW_HASKELL__ < 603
  87 #include "../../../libraries/base/System/RawSystem.hs-inc"
  88 #endif