{-# LINE 1 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE CApiFFI #-}

-----------------------------------------------------------------------------

-- |

-- Module      :  GHC.Internal.System.Environment.Blank

-- Copyright   :  (c) Habib Alamin 2017

-- License     :  BSD-style (see the file libraries/base/LICENSE)

--

-- Maintainer  :  libraries@haskell.org

-- Stability   :  provisional

-- Portability :  portable

--

-- A setEnv implementation that allows blank environment variables. Mimics

-- the `System.Posix.Env` module from the @unix@ package, but with support

-- for Windows too.

--

-- The matrix of platforms that:

--

--   * support @putenv("FOO")@ to unset environment variables,

--   * support @putenv("FOO=")@ to unset environment variables or set them

--     to blank values,

--   * support @unsetenv@ to unset environment variables,

--   * support @setenv@ to set environment variables,

--   * etc.

--

-- is very complicated. Some platforms don't support unsetting of environment

-- variables at all.

--

-----------------------------------------------------------------------------


module GHC.Internal.System.Environment.Blank
    (
      module GHC.Internal.System.Environment,
      getEnv,
      getEnvDefault,
      setEnv,
      unsetEnv,
  ) where

import GHC.Internal.Data.Functor
import GHC.Internal.Data.List (elem, null, takeWhile)
import GHC.Internal.Foreign.C.String
import GHC.Internal.Base

{-# LINE 47 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}
import GHC.Internal.Foreign.Ptr
import GHC.Internal.Windows
import GHC.Internal.Control.Monad
import GHC.Internal.Data.List (lookup)

{-# LINE 58 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}
import GHC.Internal.IO.Exception
import GHC.Internal.System.IO.Error
import GHC.Internal.Control.Exception.Base
import GHC.Internal.Data.Maybe

import GHC.Internal.System.Environment
    (
      getArgs,
      getProgName,
      getExecutablePath,
      withArgs,
      withProgName,
      getEnvironment
  )

{-# LINE 75 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}

-- TODO: include windows_cconv.h when it's merged, instead of duplicating

-- this C macro block.


{-# LINE 79 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}

{-# LINE 82 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}
#  define WINDOWS_CCONV ccall

{-# LINE 86 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}

{-# LINE 87 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}



throwInvalidArgument :: String -> IO a
throwInvalidArgument :: forall a. String -> IO a
throwInvalidArgument String
from =
  IOError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
InvalidArgument String
from Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)

-- | Similar to 'GHC.Internal.System.Environment.lookupEnv'.

getEnv :: String -> IO (Maybe String)

{-# LINE 97 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}
getEnv = (<$> getEnvironment) . lookup

{-# LINE 101 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}

-- | Get an environment value or a default value.

getEnvDefault ::
  String    {- ^ variable name                    -} ->
  String    {- ^ fallback value                   -} ->
  IO String {- ^ variable value or fallback value -}
getEnvDefault :: String -> String -> IO String
getEnvDefault String
name String
fallback = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
fallback (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
getEnv String
name

-- | Like 'GHC.Internal.System.Environment.setEnv', but allows blank environment values

-- and mimics the function signature of 'System.Posix.Env.setEnv' from the

-- @unix@ package.

--

-- Beware that this function must not be executed concurrently

-- with 'getEnv', 'lookupEnv', 'getEnvironment' and such. One thread

-- reading environment variables at the same time with another one modifying them

-- can result in a segfault, see

-- [Setenv is not Thread Safe](https://www.evanjones.ca/setenv-is-not-thread-safe.html)

-- for discussion.

setEnv ::
  String {- ^ variable name  -} ->
  String {- ^ variable value -} ->
  Bool   {- ^ overwrite      -} ->
  IO ()
setEnv :: String -> String -> Bool -> IO ()
setEnv String
key_ String
value_ Bool
overwrite
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
key       = String -> IO ()
forall a. String -> IO a
throwInvalidArgument String
"setEnv"
  | Char
'=' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
key = String -> IO ()
forall a. String -> IO a
throwInvalidArgument String
"setEnv"
  | Bool
otherwise      =
    if Bool
overwrite
    then String -> String -> IO ()
setEnv_ String
key String
value
    else do
      env_var <- String -> IO (Maybe String)
getEnv String
key
      case env_var of
          Just String
_  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Maybe String
Nothing -> String -> String -> IO ()
setEnv_ String
key String
value
  where
    key :: String
key   = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\NUL') String
key_
    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 ()

{-# LINE 141 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}
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

{-# LINE 157 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}

-- | Like 'GHC.Internal.System.Environment.unsetEnv', but allows for the removal of

-- blank environment variables. May throw an exception if the underlying

-- platform doesn't support unsetting of environment variables.

--

-- Beware that this function must not be executed concurrently

-- with 'getEnv', 'lookupEnv', 'getEnvironment' and such. One thread

-- reading environment variables at the same time with another one modifying them

-- can result in a segfault, see

-- [Setenv is not Thread Safe](https://www.evanjones.ca/setenv-is-not-thread-safe.html)

-- for discussion.

unsetEnv :: String -> IO ()

unsetEnv :: String -> IO ()
{-# LINE 170 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}
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"

eRROR_ENVVAR_NOT_FOUND :: DWORD
eRROR_ENVVAR_NOT_FOUND :: DWORD
eRROR_ENVVAR_NOT_FOUND = DWORD
203

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

{-# LINE 216 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\Blank.hsc" #-}