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.Directory
  29 import System.Exit
  30 import Data.Char
  31
  32 #if __GLASGOW_HASKELL__ < 603
  33 import Foreign          ( withMany, withArray0, nullPtr, Ptr )
  34 import Foreign.C        ( CString, withCString, throwErrnoIfMinus1 )
  35 #else
  36 import System.Cmd       ( rawSystem )
  37 #endif
  38
  39 main = do
  40   args <- getArgs
  41   case args of
  42     ('-':'f' : ghc) : filename : args -> do
  43         doIt (dropWhile isSpace ghc) filename args
  44     filename : args -> do
  45         path <- getEnv "PATH" `catch` \e -> return "."
  46         ghc <- findBinary "ghc"
  47         doIt ghc filename args
  48     _other -> do
  49         dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
  50
  51 doIt ghc filename args = do
  52   res <- rawSystem ghc ["-e","System.Environment.withArgs ["
  53                         ++ concat (intersperse "," (map show args))
  54                         ++ "] Main.main", filename]
  55   exitWith res
  56
  57 findBinary :: String -> IO FilePath
  58 findBinary binary = do
  59   path <- getEnv "PATH"
  60   search (parsePath path)
  61   where
  62     search :: [FilePath] -> IO FilePath
  63     search [] = dieProg ("cannot find " ++ binary)
  64     search (d:ds) = do
  65         let path = d ++ '/':binary
  66         b <- doesFileExist path
  67         if b  then return path else search ds
  68
  69 parsePath :: String -> [FilePath]
  70 parsePath path = split pathSep path
  71   where
  72 #ifdef mingw32_TARGET_OS
  73         pathSep = ';'
  74 #else
  75         pathSep = ':'
  76 #endif
  77
  78 split :: Char -> String -> [String]
  79 split c s = case rest of
  80                 []     -> [chunk]
  81                 _:rest -> chunk : split c rest
  82   where (chunk, rest) = break (==c) s
  83
  84 die :: String -> IO a
  85 die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
  86
  87 dieProg :: String -> IO a
  88 dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg)
  89
  90 #if __GLASGOW_HASKELL__ < 603
  91 #include "../../../libraries/base/System/RawSystem.hs-inc"
  92 #endif