{-# LINE 1 "libraries/unix/System/Posix/Env.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Env
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX environment support
--
-----------------------------------------------------------------------------

module System.Posix.Env (
      getEnv
    , getEnvDefault
    , getEnvironmentPrim
    , getEnvironment
    , setEnvironment
    , putEnv
    , setEnv
    , unsetEnv
    , clearEnv
) where



import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Control.Monad
import Data.Maybe (fromMaybe)
import System.Posix.Internals

-- |'getEnv' looks up a variable in the environment.

getEnv ::
  String            {- ^ variable name  -} ->
  IO (Maybe String) {- ^ variable value -}
getEnv :: String -> IO (Maybe String)
getEnv String
name = do
  CString
litstring <- String -> (CString -> IO CString) -> IO CString
forall a. String -> (CString -> IO a) -> IO a
withFilePath String
name CString -> IO CString
c_getenv
  if CString
litstring CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr
     then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekFilePath CString
litstring
     else Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

-- |'getEnvDefault' is a wrapper around 'getEnv' where the
-- programmer can specify a fallback if the variable is not found
-- in the environment.

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

foreign import ccall unsafe "getenv"
   c_getenv :: CString -> IO CString

getEnvironmentPrim :: IO [String]
getEnvironmentPrim :: IO [String]
getEnvironmentPrim = do
  Ptr CString
c_environ <- IO (Ptr CString)
getCEnviron
  -- environ can be NULL
  if Ptr CString
c_environ Ptr CString -> Ptr CString -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CString
forall a. Ptr a
nullPtr
    then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      [CString]
arr <- CString -> Ptr CString -> IO [CString]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 CString
forall a. Ptr a
nullPtr Ptr CString
c_environ
      (CString -> IO String) -> [CString] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CString -> IO String
peekFilePath [CString]
arr

getCEnviron :: IO (Ptr CString)

{-# LINE 84 "libraries/unix/System/Posix/Env.hsc" #-}
getCEnviron :: IO (Ptr CString)
getCEnviron = Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CString)
c_environ_p
foreign import ccall unsafe "&environ"
   c_environ_p :: Ptr (Ptr CString)

{-# LINE 88 "libraries/unix/System/Posix/Env.hsc" #-}

-- |'getEnvironment' retrieves the entire environment as a
-- list of @(key,value)@ pairs.

getEnvironment :: IO [(String,String)] {- ^ @[(key,value)]@ -}
getEnvironment :: IO [(String, String)]
getEnvironment = do
  [String]
env <- IO [String]
getEnvironmentPrim
  [(String, String)] -> IO [(String, String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)] -> IO [(String, String)])
-> [(String, String)] -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String, String) -> (String, String)
dropEq((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'='))) [String]
env
 where
   dropEq :: (String, String) -> (String, String)
dropEq (String
x,Char
'=':String
ys) = (String
x,String
ys)
   dropEq (String
x,String
_)      = String -> (String, String)
forall a. HasCallStack => String -> a
error (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
"getEnvironment: insane variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x

-- |'setEnvironment' resets the entire environment to the given list of
-- @(key,value)@ pairs.

setEnvironment ::
  [(String,String)] {- ^ @[(key,value)]@ -} ->
  IO ()
setEnvironment :: [(String, String)] -> IO ()
setEnvironment [(String, String)]
env = do
  IO ()
clearEnv
  [(String, String)] -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
env (((String, String) -> IO ()) -> IO ())
-> ((String, String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
key,String
value) ->
    String -> String -> Bool -> IO ()
setEnv String
key String
value Bool
True {-overwrite-}

-- |The 'unsetEnv' function deletes all instances of the variable name
-- from the environment.

unsetEnv :: String {- ^ variable name -} -> IO ()

{-# LINE 116 "libraries/unix/System/Posix/Env.hsc" #-}

unsetEnv :: String -> IO ()
{-# LINE 117 "libraries/unix/System/Posix/Env.hsc" #-}
unsetEnv name = withFilePath name $ \ s ->
  throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)

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

{-# LINE 130 "libraries/unix/System/Posix/Env.hsc" #-}

{-# LINE 133 "libraries/unix/System/Posix/Env.hsc" #-}

-- |'putEnv' function takes an argument of the form @name=value@
-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.

putEnv :: String {- ^ "key=value" -} -> IO ()
putEnv :: String -> IO ()
putEnv String
keyvalue = do CString
s <- String -> IO CString
newFilePath String
keyvalue
                     -- Do not free `s` after calling putenv.
                     -- According to SUSv2, the string passed to putenv
                     -- becomes part of the environment. #7342
                     String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"putenv" (CString -> IO CInt
c_putenv CString
s)

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

{- |The 'setEnv' function inserts or resets the environment variable name in
     the current environment list.  If the variable @name@ does not exist in the
     list, it is inserted with the given value.  If the variable does exist,
     the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is
     not reset, otherwise it is reset to the given value.
-}

setEnv ::
  String {- ^ variable name  -} ->
  String {- ^ variable value -} ->
  Bool   {- ^ overwrite      -} ->
  IO ()

{-# LINE 160 "libraries/unix/System/Posix/Env.hsc" #-}
setEnv key value ovrwrt = do
  withFilePath key $ \ keyP ->
    withFilePath value $ \ valueP ->
      throwErrnoIfMinus1_ "setenv" $
        c_setenv keyP valueP (fromIntegral (fromEnum ovrwrt))

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

{-# LINE 176 "libraries/unix/System/Posix/Env.hsc" #-}

-- |The 'clearEnv' function clears the environment of all name-value pairs.
clearEnv :: IO ()

clearEnv :: IO ()
{-# LINE 180 "libraries/unix/System/Posix/Env.hsc" #-}
clearEnv = void c_clearenv

foreign import ccall unsafe "clearenv"
  c_clearenv :: IO Int

{-# LINE 191 "libraries/unix/System/Posix/Env.hsc" #-}