{-# LINE 1 "System/Posix/Env.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LINE 3 "System/Posix/Env.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 7 "System/Posix/Env.hsc" #-}
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
{-# LINE 50 "System/Posix/Env.hsc" #-}
getEnv ::
String ->
IO (Maybe String)
getEnv name = do
litstring <- withFilePath name c_getenv
if litstring /= nullPtr
then liftM Just $ peekFilePath litstring
else return Nothing
getEnvDefault ::
String ->
String ->
IO String
getEnvDefault name fallback = liftM (fromMaybe fallback) (getEnv name)
foreign import ccall unsafe "getenv"
c_getenv :: CString -> IO CString
getEnvironmentPrim :: IO [String]
getEnvironmentPrim = do
c_environ <- getCEnviron
if c_environ == nullPtr
then return []
else do
arr <- peekArray0 nullPtr c_environ
mapM peekFilePath arr
getCEnviron :: IO (Ptr CString)
{-# LINE 94 "System/Posix/Env.hsc" #-}
getCEnviron = peek c_environ_p
foreign import ccall unsafe "&environ"
c_environ_p :: Ptr (Ptr CString)
{-# LINE 98 "System/Posix/Env.hsc" #-}
getEnvironment :: IO [(String,String)]
getEnvironment = do
env <- getEnvironmentPrim
return $ map (dropEq.(break ((==) '='))) env
where
dropEq (x,'=':ys) = (x,ys)
dropEq (x,_) = error $ "getEnvironment: insane variable " ++ x
setEnvironment ::
[(String,String)] ->
IO ()
setEnvironment env = do
clearEnv
forM_ env $ \(key,value) ->
setEnv key value True
unsetEnv :: String -> IO ()
{-# LINE 126 "System/Posix/Env.hsc" #-}
{-# LINE 127 "System/Posix/Env.hsc" #-}
unsetEnv name = withFilePath name $ \ s ->
throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)
foreign import capi unsafe "HsUnix.h unsetenv"
c_unsetenv :: CString -> IO CInt
{-# LINE 140 "System/Posix/Env.hsc" #-}
{-# LINE 143 "System/Posix/Env.hsc" #-}
putEnv :: String -> IO ()
putEnv keyvalue = do s <- newFilePath keyvalue
throwErrnoIfMinus1_ "putenv" (c_putenv s)
{-# LINE 158 "System/Posix/Env.hsc" #-}
foreign import ccall unsafe "putenv"
c_putenv :: CString -> IO CInt
setEnv ::
String ->
String ->
Bool ->
IO ()
{-# LINE 175 "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 191 "System/Posix/Env.hsc" #-}
clearEnv :: IO ()
{-# LINE 195 "System/Posix/Env.hsc" #-}
clearEnv = void c_clearenv
foreign import ccall unsafe "clearenv"
c_clearenv :: IO Int
{-# LINE 206 "System/Posix/Env.hsc" #-}