{-# 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 52 "libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc" #-}
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Real (fromIntegral)
import GHC.Internal.Enum
import GHC.Internal.System.Posix.Internals

{-# 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 73 "libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc" #-}
import qualified GHC.Internal.System.Environment as Environment

{-# 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 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 99 "libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc" #-}
getEnv :: String -> IO (Maybe String)
getEnv = String -> IO (Maybe String)
Environment.lookupEnv

{-# 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 148 "libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc" #-}
setEnv_ :: String -> String -> IO ()
setEnv_ String
key String
value =
  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))

foreign import ccall unsafe "setenv"
   c_setenv :: CString -> CString -> CInt -> IO CInt

{-# 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 ()

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

unsetEnv :: String -> IO ()
{-# LINE 186 "libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc" #-}
unsetEnv name = withFilePath name $ \ s ->
  throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)

-- POSIX.1-2001 compliant unsetenv(3)
foreign import capi unsafe "HsBase.h unsetenv"
   c_unsetenv :: CString -> IO CInt

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

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