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