aeffeb41c8663f8a30247abeedeeb40048ae25d5
[ghc.git] / libraries / base / GHC / Environment.hs
1 {-# LANGUAGE CPP, ForeignFunctionInterface #-}
2
3 module GHC.Environment (getFullArgs) where
4
5 import Prelude
6 import Foreign
7 import Foreign.C
8
9 #ifdef mingw32_HOST_OS
10 import GHC.IO (finally)
11 import GHC.Windows
12
13 -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
14 getFullArgs :: IO [String]
15 getFullArgs = do
16 p_arg_string <- c_GetCommandLine
17 alloca $ \p_argc -> do
18 p_argv <- c_CommandLineToArgv p_arg_string p_argc
19 if p_argv == nullPtr
20 then throwGetLastError "getFullArgs"
21 else flip finally (c_LocalFree p_argv) $ do
22 argc <- peek p_argc
23 p_argvs <- peekArray (fromIntegral argc) p_argv
24 mapM peekCWString p_argvs
25
26 foreign import stdcall unsafe "windows.h GetCommandLineW"
27 c_GetCommandLine :: IO (Ptr CWString)
28
29 foreign import stdcall unsafe "windows.h CommandLineToArgvW"
30 c_CommandLineToArgv :: Ptr CWString -> Ptr CInt -> IO (Ptr CWString)
31
32 foreign import stdcall unsafe "Windows.h LocalFree"
33 c_LocalFree :: Ptr a -> IO (Ptr a)
34 #else
35 import Control.Monad
36
37 import GHC.IO.Encoding
38 import qualified GHC.Foreign as GHC
39
40 getFullArgs :: IO [String]
41 getFullArgs =
42 alloca $ \ p_argc ->
43 alloca $ \ p_argv -> do
44 getFullProgArgv p_argc p_argv
45 p <- fromIntegral `liftM` peek p_argc
46 argv <- peek p_argv
47 peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)
48
49 foreign import ccall unsafe "getFullProgArgv"
50 getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
51 #endif