    {-# LANGUAGE Safe #-}
    {-# LANGUAGE CPP #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  System.Environment
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- Miscellaneous information about the system environment.
    --
    -----------------------------------------------------------------------------

    module System.Environment
        (
          getArgs,
          getProgName,
          getExecutablePath,
          getEnv,
          lookupEnv,
          setEnv,
          unsetEnv,
          withArgs,
          withProgName,
          getEnvironment,
      ) where

    import Foreign
    import Foreign.C
    import System.IO.Error (mkIOError)
    import Control.Exception.Base (bracket, throwIO)
    -- import GHC.IO
    import GHC.IO.Exception
    import GHC.IO.Encoding (getFileSystemEncoding)
    import qualified GHC.Foreign as GHC
    import Data.List
    import Control.Monad
    #ifdef mingw32_HOST_OS
    import GHC.Environment
    import GHC.Windows
    #else
    import System.Posix.Internals (withFilePath)
    #endif

    import System.Environment.ExecutablePath

    #ifdef mingw32_HOST_OS
    # if defined(i386_HOST_ARCH)
    #  define WINDOWS_CCONV stdcall
    # elif defined(x86_64_HOST_ARCH)
    #  define WINDOWS_CCONV ccall
    # else
    #  error Unknown mingw32 arch
    # endif
    #endif

    #include "HsBaseConfig.h"

    -- ---------------------------------------------------------------------------
    -- getArgs, getProgName, getEnv

    #ifdef mingw32_HOST_OS

    -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat

    getWin32ProgArgv_certainly :: IO [String]
    getWin32ProgArgv_certainly = do
            mb_argv <- getWin32ProgArgv
            case mb_argv of
              Nothing   -> fmap dropRTSArgs getFullArgs
              Just argv -> return argv

    withWin32ProgArgv :: [String] -> IO a -> IO a
    withWin32ProgArgv argv act = bracket begin setWin32ProgArgv (\_ -> act)
      where
        begin = do
              mb_old_argv <- getWin32ProgArgv
              setWin32ProgArgv (Just argv)
              return mb_old_argv

    getWin32ProgArgv :: IO (Maybe [String])
    getWin32ProgArgv = alloca $ \p_argc -> alloca $ \p_argv -> do
            c_getWin32ProgArgv p_argc p_argv
            argc <- peek p_argc
            argv_p <- peek p_argv
            if argv_p == nullPtr
             then return Nothing
             else do
              argv_ps <- peekArray (fromIntegral argc) argv_p
              fmap Just $ mapM peekCWString argv_ps

    setWin32ProgArgv :: Maybe [String] -> IO ()
    setWin32ProgArgv Nothing = c_setWin32ProgArgv 0 nullPtr
    setWin32ProgArgv (Just argv) = withMany withCWString argv $ \argv_ps -> withArrayLen argv_ps $ \argc argv_p -> do
            c_setWin32ProgArgv (fromIntegral argc) argv_p

    foreign import ccall unsafe "getWin32ProgArgv"
      c_getWin32ProgArgv :: Ptr CInt -> Ptr (Ptr CWString) -> IO ()

    foreign import ccall unsafe "setWin32ProgArgv"
      c_setWin32ProgArgv :: CInt -> Ptr CWString -> IO ()

    dropRTSArgs :: [String] -> [String]
    dropRTSArgs []             = []
    dropRTSArgs ("+RTS":rest)  = dropRTSArgs (dropWhile (/= "-RTS") rest)
    dropRTSArgs ("--RTS":rest) = rest
    dropRTSArgs ("-RTS":rest)  = dropRTSArgs rest
    dropRTSArgs (arg:rest)     = arg : dropRTSArgs rest

    #endif

    -- | Computation 'getArgs' returns a list of the program's command
    -- line arguments (not including the program name).
    getArgs :: IO [String]

    #ifdef mingw32_HOST_OS
    getArgs =  fmap tail getWin32ProgArgv_certainly
    #else
    getArgs =
      alloca $ \ p_argc ->
      alloca $ \ p_argv -> do
       getProgArgv p_argc p_argv
       p    <- fromIntegral `liftM` peek p_argc
       argv <- peek p_argv
       enc <- getFileSystemEncoding
       peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)

    foreign import ccall unsafe "getProgArgv"
      getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
    #endif

    {-|
    Computation 'getProgName' returns the name of the program as it was
    invoked.

    However, this is hard-to-impossible to implement on some non-Unix
    OSes, so instead, for maximum portability, we just return the leafname
    of the program as invoked. Even then there are some differences
    between platforms: on Windows, for example, a program invoked as foo
    is probably really @FOO.EXE@, and that is what 'getProgName' will return.
    -}
    getProgName :: IO String
    #ifdef mingw32_HOST_OS
    -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
    getProgName = fmap (basename . head) getWin32ProgArgv_certainly
    #else
    getProgName =
      alloca $ \ p_argc ->
      alloca $ \ p_argv -> do
         getProgArgv p_argc p_argv
         argv <- peek p_argv
         unpackProgName argv

    unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
    unpackProgName argv = do
      enc <- getFileSystemEncoding
      s <- peekElemOff argv 0 >>= GHC.peekCString enc
      return (basename s)
    #endif

    basename :: FilePath -> FilePath
    basename f = go f f
     where
      go acc [] = acc
      go acc (x:xs)
        | isPathSeparator x = go xs xs
        | otherwise         = go acc xs

      isPathSeparator :: Char -> Bool
      isPathSeparator '/'  = True
    #ifdef mingw32_HOST_OS
      isPathSeparator '\\' = True
    #endif
      isPathSeparator _    = False

    -- | Computation 'getEnv' @var@ returns the value
    -- of the environment variable @var@. For the inverse, POSIX users
    -- can use 'System.Posix.Env.putEnv'.
    --
    -- This computation may fail with:
    --
    --  * 'System.IO.Error.isDoesNotExistError' if the environment variable
    --    does not exist.

    getEnv :: String -> IO String
    getEnv name = lookupEnv name >>= maybe handleError return
      where
    #ifdef mingw32_HOST_OS
        handleError = do
            err <- c_GetLastError
            if err == eRROR_ENVVAR_NOT_FOUND
                then ioe_missingEnvVar name
                else throwGetLastError "getEnv"

    eRROR_ENVVAR_NOT_FOUND :: DWORD
    eRROR_ENVVAR_NOT_FOUND = 203

    foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"
      c_GetLastError:: IO DWORD

    #else
        handleError = ioe_missingEnvVar name
    #endif

    -- | Return the value of the environment variable @var@, or @Nothing@ if
    -- there is no such value.
    --
    -- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'.
    --
    -- @since 4.6.0.0
    lookupEnv :: String -> IO (Maybe String)
    #ifdef mingw32_HOST_OS
    lookupEnv name = withCWString name $ \s -> try_size s 256
      where
        try_size s size = allocaArray (fromIntegral size) $ \p_value -> do
          res <- c_GetEnvironmentVariable s p_value size
          case res of
            0 -> return Nothing
            _ | res > size -> try_size s res -- Rare: size increased between calls to GetEnvironmentVariable
              | otherwise  -> peekCWString p_value >>= return . Just

    foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentVariableW"
      c_GetEnvironmentVariable :: LPWSTR -> LPWSTR -> DWORD -> IO DWORD
    #else
    lookupEnv name =
        withCString name $ \s -> do
          litstring <- c_getenv s
          if litstring /= nullPtr
            then do enc <- getFileSystemEncoding
                    result <- GHC.peekCString enc litstring
                    return $ Just result
            else return Nothing

    foreign import ccall unsafe "getenv"
       c_getenv :: CString -> IO (Ptr CChar)
    #endif

    ioe_missingEnvVar :: String -> IO a
    ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv"
        "no environment variable" Nothing (Just name))

    -- | @setEnv name value@ sets the specified environment variable to @value@.
    --
    -- On Windows setting an environment variable to the /empty string/ removes
    -- that environment variable from the environment.  For the sake of
    -- compatibility we adopt that behavior.  In particular
    --
    -- @
    -- setEnv name \"\"
    -- @
    --
    -- has the same effect as
    --
    -- @
    -- `unsetEnv` name
    -- @
    --
    -- If you don't care about Windows support and want to set an environment
    -- variable to the empty string use @System.Posix.Env.setEnv@ from the @unix@
    -- package instead.
    --
    -- Throws `Control.Exception.IOException` if @name@ is the empty string or
    -- contains an equals sign.
    --
    -- @since 4.7.0.0
    setEnv :: String -> String -> IO ()
    setEnv key_ value_
      | null key       = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing)
      | '=' `elem` key = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing)
      | null value     = unsetEnv key
      | otherwise      = setEnv_ key value
      where
        key   = takeWhile (/= '\NUL') key_
        value = takeWhile (/= '\NUL') value_

    setEnv_ :: String -> String -> IO ()
    #ifdef mingw32_HOST_OS
    setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do
      success <- c_SetEnvironmentVariable k v
      unless success (throwGetLastError "setEnv")

    foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW"
      c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool
    #else

    -- NOTE: The 'setenv()' function is not available on all systems, hence we use
    -- 'putenv()'.  This leaks memory, but so do common implementations of
    -- 'setenv()' (AFAIK).
    setEnv_ k v = putEnv (k ++ "=" ++ v)

    putEnv :: String -> IO ()
    putEnv keyvalue = do
      s <- getFileSystemEncoding >>= (`GHC.newCString` keyvalue)
      -- IMPORTANT: Do not free `s` after calling putenv!
      --
      -- According to SUSv2, the string passed to putenv becomes part of the
      -- enviroment.
      throwErrnoIf_ (/= 0) "putenv" (c_putenv s)

    foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt
    #endif

    -- | @unSet name@ removes the specified environment variable from the
    -- environment of the current process.
    --
    -- Throws `Control.Exception.IOException` if @name@ is the empty string or
    -- contains an equals sign.
    --
    -- @since 4.7.0.0
    unsetEnv :: String -> IO ()
    #ifdef mingw32_HOST_OS
    unsetEnv key = withCWString key $ \k -> do
      success <- c_SetEnvironmentVariable k nullPtr
      unless success $ do
        -- We consider unsetting an environment variable that does not exist not as
        -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND.
        err <- c_GetLastError
        unless (err == eRROR_ENVVAR_NOT_FOUND) $ do
          throwGetLastError "unsetEnv"
    #else

    #ifdef HAVE_UNSETENV
    unsetEnv key = withFilePath key (throwErrnoIf_ (/= 0) "unsetEnv" . c_unsetenv)
    foreign import ccall unsafe "__hsbase_unsetenv" c_unsetenv :: CString -> IO CInt
    #else
    unsetEnv key = setEnv_ key ""
    #endif

    #endif

    {-|
    'withArgs' @args act@ - while executing action @act@, have 'getArgs'
    return @args@.
    -}
    withArgs :: [String] -> IO a -> IO a
    withArgs xs act = do
       p <- System.Environment.getProgName
       withArgv (p:xs) act

    {-|
    'withProgName' @name act@ - while executing action @act@,
    have 'getProgName' return @name@.
    -}
    withProgName :: String -> IO a -> IO a
    withProgName nm act = do
       xs <- System.Environment.getArgs
       withArgv (nm:xs) act

    -- Worker routine which marshals and replaces an argv vector for
    -- the duration of an action.

    withArgv :: [String] -> IO a -> IO a

    #ifdef mingw32_HOST_OS
    -- We have to reflect the updated arguments in the RTS-side variables as
    -- well, because the RTS still consults them for error messages and the like.
    -- If we don't do this then ghc-e005 fails.
    withArgv new_args act = withWin32ProgArgv new_args $ withProgArgv new_args act
    #else
    withArgv = withProgArgv
    #endif

    withProgArgv :: [String] -> IO a -> IO a
    withProgArgv new_args act = do
      pName <- System.Environment.getProgName
      existing_args <- System.Environment.getArgs
      bracket (setProgArgv new_args)
              (\argv -> do _ <- setProgArgv (pName:existing_args)
                           freeProgArgv argv)
              (const act)

    freeProgArgv :: Ptr CString -> IO ()
    freeProgArgv argv = do
      size <- lengthArray0 nullPtr argv
      sequence_ [ peek (argv `advancePtr` i) >>= free
                | i <- [size - 1, size - 2 .. 0]]
      free argv

    setProgArgv :: [String] -> IO (Ptr CString)
    setProgArgv argv = do
      enc <- getFileSystemEncoding
      vs <- mapM (GHC.newCString enc) argv >>= newArray0 nullPtr
      c_setProgArgv (genericLength argv) vs
      return vs

    foreign import ccall unsafe "setProgArgv"
      c_setProgArgv  :: CInt -> Ptr CString -> IO ()

    -- |'getEnvironment' retrieves the entire environment as a
    -- list of @(key,value)@ pairs.
    --
    -- If an environment entry does not contain an @\'=\'@ character,
    -- the @key@ is the whole entry and the @value@ is the empty string.
    getEnvironment :: IO [(String, String)]

    #ifdef mingw32_HOST_OS
    getEnvironment = bracket c_GetEnvironmentStrings c_FreeEnvironmentStrings $ \pBlock ->
        if pBlock == nullPtr then return []
         else go pBlock
      where
        go pBlock = do
            -- The block is terminated by a null byte where there
            -- should be an environment variable of the form X=Y
            c <- peek pBlock
            if c == 0 then return []
             else do
              -- Seek the next pair (or terminating null):
              pBlock' <- seekNull pBlock False
              -- We now know the length in bytes, but ignore it when
              -- getting the actual String:
              str <- peekCWString pBlock
              fmap (divvy str :) $ go pBlock'

        -- Returns pointer to the byte *after* the next null
        seekNull pBlock done = do
            let pBlock' = pBlock `plusPtr` sizeOf (undefined :: CWchar)
            if done then return pBlock'
             else do
               c <- peek pBlock'
               seekNull pBlock' (c == (0 :: Word8 ))

    foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentStringsW"
      c_GetEnvironmentStrings :: IO (Ptr CWchar)

    foreign import WINDOWS_CCONV unsafe "windows.h FreeEnvironmentStringsW"
      c_FreeEnvironmentStrings :: Ptr CWchar -> IO Bool
    #else
    getEnvironment = do
       pBlock <- getEnvBlock
       if pBlock == nullPtr then return []
        else do
          enc <- getFileSystemEncoding
          stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString enc)
          return (map divvy stuff)

    foreign import ccall unsafe "__hscore_environ"
      getEnvBlock :: IO (Ptr CString)
    #endif

    divvy :: String -> (String, String)
    divvy str =
      case break (=='=') str of
        (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)
        (name,_:value) -> (name,value)