System/Environment.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  System.Environment
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  provisional
   9 -- Portability :  portable
  10 --
  11 -- Miscellaneous information about the system environment.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module System.Environment
  16     (
  17       getArgs,       -- :: IO [String]
  18       getProgName,   -- :: IO String
  19       getEnv,        -- :: String -> IO String
  20 #ifndef __HUGS__
  21       withArgs,
  22       withProgName,
  23 #endif
  24   ) where
  25
  26 import Prelude
  27 import System.IO        ( bracket )
  28
  29 #ifndef __HUGS__
  30 import Foreign
  31 import Foreign.C
  32 import Control.Monad
  33 #endif
  34
  35 #ifdef __GLASGOW_HASKELL__
  36 import GHC.IOBase
  37 #endif
  38
  39 #ifdef __HUGS__
  40 import Hugs.System
  41 #endif
  42
  43 -- ---------------------------------------------------------------------------
  44 -- getArgs, getProgName, getEnv
  45
  46 -- Computation `getArgs' returns a list of the program's command
  47 -- line arguments (not including the program name).
  48
  49 #ifndef __HUGS__
  50 getArgs :: IO [String]
  51 getArgs =
  52   alloca $ \ p_argc ->
  53   alloca $ \ p_argv -> do
  54    getProgArgv p_argc p_argv
  55    p    <- fromIntegral `liftM` peek p_argc
  56    argv <- peek p_argv
  57    peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
  58
  59
  60 foreign import ccall unsafe "getProgArgv"
  61   getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
  62
  63 {-|
  64 Computation 'getProgName' returns the name of the program as it was
  65 invoked.
  66
  67 However, this is hard-to-impossible to implement on some non-Unix
  68 OSes, so instead, for maximum portability, we just return the leafname
  69 of the program as invoked. Even then there are some differences
  70 between platforms: on Windows, for example, a program invoked as foo
  71 is probably really @FOO.EXE@, and that is what 'getProgName' will return.
  72 -}
  73 getProgName :: IO String
  74 getProgName =
  75   alloca $ \ p_argc ->
  76   alloca $ \ p_argv -> do
  77      getProgArgv p_argc p_argv
  78      argv <- peek p_argv
  79      unpackProgName argv
  80
  81 unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
  82 unpackProgName argv = do
  83   s <- peekElemOff argv 0 >>= peekCString
  84   return (basename s)
  85   where
  86    basename :: String -> String
  87    basename f = go f f
  88     where
  89       go acc [] = acc
  90       go acc (x:xs)
  91         | isPathSeparator x = go xs xs
  92         | otherwise         = go acc xs
  93
  94    isPathSeparator :: Char -> Bool
  95    isPathSeparator '/'  = True
  96 #ifdef mingw32_TARGET_OS
  97    isPathSeparator '\\' = True
  98 #endif
  99    isPathSeparator _    = False
 100
 101
 102 -- Computation `getEnv var' returns the value
 103 -- of the environment variable {\em var}.
 104
 105 -- This computation may fail with
 106 --    NoSuchThing: The environment variable does not exist.
 107
 108 getEnv :: String -> IO String
 109 getEnv name =
 110     withCString name $ \s -> do
 111       litstring <- c_getenv s
 112       if litstring /= nullPtr
 113         then peekCString litstring
 114         else ioException (IOError Nothing NoSuchThing "getEnv"
 115                           "no environment variable" (Just name))
 116
 117 foreign import ccall unsafe "getenv"
 118    c_getenv :: CString -> IO (Ptr CChar)
 119
 120 {-|
 121 @withArgs args act@ - while executing action @act@, have 'System.getArgs'
 122 return @args@.
 123 -}
 124 withArgs xs act = do
 125    p <- System.Environment.getProgName
 126    withArgv (p:xs) act
 127
 128 {-|
 129 @withProgName name act@ - while executing action @act@, have 'System.getProgName'return @name@.
 130 -}
 131 withProgName nm act = do
 132    xs <- System.Environment.getArgs
 133    withArgv (nm:xs) act
 134
 135 -- Worker routine which marshals and replaces an argv vector for
 136 -- the duration of an action.
 137
 138 withArgv new_args act = do
 139   pName <- System.Environment.getProgName
 140   existing_args <- System.Environment.getArgs
 141   bracket (setArgs new_args)
 142           (\argv -> do setArgs (pName:existing_args); freeArgv argv)
 143           (const act)
 144
 145 freeArgv :: Ptr CString -> IO ()
 146 freeArgv argv = do
 147   size <- lengthArray0 nullPtr argv
 148   sequence_ [peek (argv `advancePtr` i) >>= free | i <- [size, size-1 .. 0]]
 149   free argv
 150
 151 setArgs :: [String] -> IO (Ptr CString)
 152 setArgs argv = do
 153   vs <- mapM newCString argv >>= newArray0 nullPtr
 154   setArgsPrim (length argv) vs
 155   return vs
 156
 157 foreign import ccall unsafe "setProgArgv"
 158   setArgsPrim  :: Int -> Ptr CString -> IO ()
 159 #endif  /* __HUGS__ */