    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}
    {-# OPTIONS_HADDOCK hide #-}

    module Distribution.Compat.Environment
           ( getEnvironment, lookupEnv, setEnv, unsetEnv )
           where

    import Prelude ()
    import qualified Prelude
    import Distribution.Compat.Prelude

    import qualified System.Environment as System
    import System.Environment (lookupEnv, unsetEnv)

    import Distribution.Compat.Stack

    #ifdef mingw32_HOST_OS
    import Foreign.C
    import GHC.Windows
    #else
    import Foreign.C.Types
    import Foreign.C.String
    import Foreign.C.Error (throwErrnoIfMinus1_)
    import System.Posix.Internals ( withFilePath )
    #endif /* mingw32_HOST_OS */

    getEnvironment :: IO [(String, String)]
    #ifdef mingw32_HOST_OS
    -- On Windows, the names of environment variables are case-insensitive, but are
    -- often given in mixed-case (e.g. "PATH" is "Path"), so we have to normalise
    -- them.
    getEnvironment = fmap upcaseVars System.getEnvironment
      where
        upcaseVars = map upcaseVar
        upcaseVar (var, val) = (map toUpper var, val)
    #else
    getEnvironment :: IO [(String, String)]
    getEnvironment = IO [(String, String)]
    System.getEnvironment
    #endif

    -- | @setEnv name value@ sets the specified environment variable to @value@.
    --
    -- Throws `Control.Exception.IOException` if either @name@ or @value@ is the
    -- empty string or contains an equals sign.
    setEnv :: String -> String -> IO ()
    setEnv :: String -> String -> IO ()
    setEnv String
    key String
    value_ = String -> String -> IO ()
    setEnv_ String
    key String
    value
      where
        -- NOTE: Anything that follows NUL is ignored on both POSIX and Windows. We
        -- still strip it manually so that the null check above succeeds if a value
        -- starts with NUL.
        value :: String
    value = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\NUL') String
    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")
     where
      _ = callStack -- TODO: attach CallStack to exception

    # 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 /* i386_HOST_ARCH */

    foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW"
      c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> Prelude.IO Bool
    #else
    setEnv_ :: String -> String -> IO ()
    setEnv_ String
    key String
    value = do
      String -> (CString -> IO ()) -> IO ()
    forall a. String -> (CString -> IO a) -> IO a
    withFilePath String
    key ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ CString
    keyP ->
        String -> (CString -> IO ()) -> IO ()
    forall a. String -> (CString -> IO a) -> IO a
    withFilePath String
    value ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ CString
    valueP ->
          String -> IO CInt -> IO ()
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwErrnoIfMinus1_ String
    "setenv" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            CString -> CString -> CInt -> IO CInt
    c_setenv CString
    keyP CString
    valueP (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum Bool
    True))
     where
      CallStack
    _ = CallStack
    HasCallStack => CallStack
    callStack -- TODO: attach CallStack to exception

    foreign import ccall unsafe "setenv"
       c_setenv :: CString -> CString -> CInt -> Prelude.IO CInt
    #endif /* mingw32_HOST_OS */