blob: f8330b5721363fb540cced05355d274dda3c69cb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
{-# OPTIONS -cpp -fffi #-}
#if __GLASGOW_HASKELL__ < 603
#include "config.h"
#else
#include "ghcconfig.h"
#endif
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow, 2004
--
-- runghc program, for invoking from a #! line in a script. For example:
--
-- script.lhs:
-- #! /usr/bin/runghc
-- > main = putStrLn "hello!"
--
-- runghc accepts one flag:
--
-- -f <path> specify the path
--
-- -----------------------------------------------------------------------------
module Main where
import System.Environment
import System.IO
import Data.List
import System.Exit
import Data.Char
import Compat.RawSystem ( rawSystem )
import Compat.Directory ( findExecutable )
main = do
args <- getArgs
case args of
('-':'f' : ghc) : args -> do
doIt (dropWhile isSpace ghc) args
args -> do
mb_ghc <- findExecutable "ghc"
case mb_ghc of
Nothing -> dieProg ("cannot find ghc")
Just ghc -> doIt ghc args
doIt ghc args = do
let
(ghc_args, rest) = break notArg args
--
case rest of
[] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
filename : prog_args -> do
res <- rawSystem ghc (
"-ignore-dot-ghci" : ghc_args ++
[ "-e","System.Environment.withProgName "++show filename++" (System.Environment.withArgs ["
++ concat (intersperse "," (map show prog_args))
++ "] Main.main)", filename])
exitWith res
notArg ('-':_) = False
notArg _ = True
dieProg :: String -> IO a
dieProg msg = do
p <- getProgName
hPutStrLn stderr (p ++ ": " ++ msg)
exitWith (ExitFailure 1)
|
