ghc/utils/runghc/runghc.hs

   1 {-# OPTIONS -cpp #-}
   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 System.Cmd
  24 import Data.List
  25 import System.Directory
  26 import System.Exit
  27 import Data.Char
  28
  29 main = do
  30   args <- getArgs
  31   case args of
  32     ('-':'f' : ghc) : filename : args -> do
  33         doIt (dropWhile isSpace ghc) filename args
  34     filename : args -> do
  35         path <- getEnv "PATH" `catch` \e -> return "."
  36         ghc <- findBinary "ghc"
  37         doIt ghc filename args
  38     _other -> do
  39         dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
  40
  41 doIt ghc filename args = do
  42   res <- rawSystem ghc ["-e","System.Environment.withArgs ["
  43                         ++ concat (intersperse "," (map show args))
  44                         ++ "] Main.main", filename]
  45   exitWith res
  46
  47 findBinary :: String -> IO FilePath
  48 findBinary binary = do
  49   path <- getEnv "PATH"
  50   search (parsePath path)
  51   where
  52     search :: [FilePath] -> IO FilePath
  53     search [] = dieProg ("cannot find " ++ binary)
  54     search (d:ds) = do
  55         let path = d ++ '/':binary
  56         b <- doesFileExist path
  57         if b  then return path else search ds
  58
  59 parsePath :: String -> [FilePath]
  60 parsePath path = split pathSep path
  61   where
  62 #ifdef mingw32_TARGET_OS
  63         pathSep = ';'
  64 #else
  65         pathSep = ':'
  66 #endif
  67
  68 split :: Char -> String -> [String]
  69 split c s = case rest of
  70                 []     -> [chunk]
  71                 _:rest -> chunk : split c rest
  72   where (chunk, rest) = break (==c) s
  73
  74 die :: String -> IO a
  75 die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
  76
  77 dieProg :: String -> IO a
  78 dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg)
  79