{-# LANGUAGE CPP, ForeignFunctionInterface #-}
-#if __GLASGOW_HASKELL__ < 603
-#include "config.h"
-#else
#include "ghcconfig.h"
-#endif
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow, 2004
module Main (main) where
import Control.Exception
-import Data.Char
-import Data.List
import Data.Monoid
import System.Cmd
import System.Directory
args <- getArgs
case parseRunGhcFlags args of
(Help, _) -> printUsage
+ (ShowVersion, _) -> printVersion
(RunGhcFlags (Just ghc), args') -> doIt ghc args'
(RunGhcFlags Nothing, args') -> do
mbPath <- getExecPath
data RunGhcFlags = RunGhcFlags (Maybe FilePath) -- GHC location
| Help -- Print help text
+ | ShowVersion -- Print version info
instance Monoid RunGhcFlags where
mempty = RunGhcFlags Nothing
Help `mappend` _ = Help
_ `mappend` Help = Help
+ ShowVersion `mappend` _ = ShowVersion
+ _ `mappend` ShowVersion = ShowVersion
RunGhcFlags _ `mappend` right@(RunGhcFlags (Just _)) = right
left@(RunGhcFlags _) `mappend` RunGhcFlags Nothing = left
f flags (('-' : 'f' : ghc) : args)
= f (flags `mappend` RunGhcFlags (Just ghc)) args
f flags ("--help" : args) = f (flags `mappend` Help) args
+ f flags ("--version" : args) = f (flags `mappend` ShowVersion) args
-- If you need the first GHC flag to be a -f flag then
-- you can pass -- first
f flags ("--" : args) = (flags, args)
f flags args = (flags, args)
+printVersion :: IO ()
+printVersion = do
+ putStrLn ("runghc " ++ VERSION)
+
printUsage :: IO ()
printUsage = do
putStrLn "Usage: runghc [runghc flags] [GHC flags] module [program args]"
putStrLn "The runghc flags are"
putStrLn " -f /path/to/ghc Tell runghc where GHC is"
putStrLn " --help Print this usage information"
+ putStrLn " --version Print version number"
doIt :: String -> [String] -> IO ()
doIt ghc args = do
getExecPath :: IO (Maybe String)
#if defined(mingw32_HOST_OS)
-getExecPath =
- allocaArray len $ \buf -> do
- ret <- getModuleFileName nullPtr buf len
- if ret == 0 then return Nothing
- else liftM Just $ peekCString buf
- where len = 2048 -- Plenty, PATH_MAX is 512 under Win32.
-
-foreign import stdcall unsafe "GetModuleFileNameA"
- getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
+getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
+ where
+ try_size size = allocaArray (fromIntegral size) $ \buf -> do
+ ret <- c_GetModuleFileName nullPtr buf size
+ case ret of
+ 0 -> return Nothing
+ _ | ret < size -> fmap Just $ peekCWString buf
+ | otherwise -> try_size (size * 2)
+
+foreign import stdcall unsafe "windows.h GetModuleFileNameW"
+ c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
#else
getExecPath = return Nothing
#endif