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 import Compat.RawSystem         ( rawSystem )
  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         path <- getEnv "PATH" `catch` \e -> return "."
  41         ghc <- findBinary "ghc"
  42         doIt ghc filename args
  43     _other -> do
  44         dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
  45
  46 doIt ghc filename args = do
  47   res <- rawSystem ghc ["-e","System.Environment.withArgs ["
  48                         ++ concat (intersperse "," (map show args))
  49                         ++ "] Main.main", filename]
  50   exitWith res
  51
  52 findBinary :: String -> IO FilePath
  53 findBinary binary = do
  54   path <- getEnv "PATH"
  55   search (parsePath path)
  56   where
  57     search :: [FilePath] -> IO FilePath
  58     search [] = dieProg ("cannot find " ++ binary)
  59     search (d:ds) = do
  60         let path = d ++ '/':binary
  61         b <- doesFileExist path
  62         if b  then return path else search ds
  63
  64 parsePath :: String -> [FilePath]
  65 parsePath path = split pathSep path
  66   where
  67 #ifdef mingw32_TARGET_OS
  68         pathSep = ';'
  69 #else
  70         pathSep = ':'
  71 #endif
  72
  73 split :: Char -> String -> [String]
  74 split c s = case rest of
  75                 []     -> [chunk]
  76                 _:rest -> chunk : split c rest
  77   where (chunk, rest) = break (==c) s
  78
  79 die :: String -> IO a
  80 die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
  81
  82 dieProg :: String -> IO a
  83 dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg)