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