{-# 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" #-}



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

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

getEnv :: String -> IO (Maybe String)

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

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

setEnv_ :: String -> String -> IO ()

{-# LINE 129 "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 ccall unsafe "windows.h SetEnvironmentVariableW"
  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool

{-# LINE 145 "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 :: [Char] -> IO ()
{-# LINE 158 "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 :: Word32
eRROR_ENVVAR_NOT_FOUND = Word32
203

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

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