{-# LINE 1 "libraries/unix/System/Posix/Env/ByteString.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE Trustworthy #-}

{-# LINE 4 "libraries/unix/System/Posix/Env/ByteString.hsc" #-}
{-# OPTIONS_GHC -fno-warn-trustworthy-safe #-}

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

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Env.ByteString
-- 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.ByteString (
       -- * Environment Variables
        getEnv
        , getEnvDefault
        , getEnvironmentPrim
        , getEnvironment
        , putEnv
        , setEnv
       , unsetEnv

       -- * Program arguments
       , getArgs
) where



import Foreign
import Foreign.C
import Control.Monad    ( liftM )
import Data.Maybe       ( fromMaybe )

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.ByteString (ByteString)

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

getEnv ::
  ByteString            {- ^ variable name  -} ->
  IO (Maybe ByteString) {- ^ variable value -}
getEnv :: ByteString -> IO (Maybe ByteString)
getEnv ByteString
name = do
  CString
litstring <- ByteString -> (CString -> IO CString) -> IO CString
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
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 (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ CString -> IO ByteString
B.packCString CString
litstring
     else Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
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 ::
  ByteString    {- ^ variable name                    -} ->
  ByteString    {- ^ fallback value                   -} ->
  IO ByteString {- ^ variable value or fallback value -}
getEnvDefault :: ByteString -> ByteString -> IO ByteString
getEnvDefault ByteString
name ByteString
fallback = (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
fallback) (ByteString -> IO (Maybe ByteString)
getEnv ByteString
name)

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

getEnvironmentPrim :: IO [ByteString]
getEnvironmentPrim :: IO [ByteString]
getEnvironmentPrim = do
  Ptr CString
c_environ <- IO (Ptr CString)
getCEnviron
  [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 ByteString) -> [CString] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CString -> IO ByteString
B.packCString [CString]
arr

getCEnviron :: IO (Ptr CString)

{-# LINE 85 "libraries/unix/System/Posix/Env/ByteString.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 90 "libraries/unix/System/Posix/Env/ByteString.hsc" #-}

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

getEnvironment :: IO [(ByteString,ByteString)] {- ^ @[(key,value)]@ -}
getEnvironment :: IO [(ByteString, ByteString)]
getEnvironment = do
  [ByteString]
env <- IO [ByteString]
getEnvironmentPrim
  [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ByteString, ByteString)] -> IO [(ByteString, ByteString)])
-> [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString, ByteString) -> (ByteString, ByteString)
dropEq((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'='))) [ByteString]
env
 where
   dropEq :: (ByteString, ByteString) -> (ByteString, ByteString)
dropEq (ByteString
x,ByteString
y)
      | ByteString -> Char
BC.head ByteString
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' = (ByteString
x,ByteString -> ByteString
B.tail ByteString
y)
      | Bool
otherwise       = [Char] -> (ByteString, ByteString)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (ByteString, ByteString))
-> [Char] -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ [Char]
"getEnvironment: insane variable " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC.unpack ByteString
x

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

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

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

unsetEnv :: ByteString -> IO ()
{-# LINE 109 "libraries/unix/System/Posix/Env/ByteString.hsc" #-}
unsetEnv name = B.useAsCString 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 122 "libraries/unix/System/Posix/Env/ByteString.hsc" #-}

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

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

putEnv :: ByteString {- ^ "key=value" -} -> IO ()
putEnv :: ByteString -> IO ()
putEnv ByteString
keyvalue = ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
keyvalue ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
s ->
  [Char] -> IO CInt -> IO ()
forall a. (Eq a, Num a) => [Char] -> IO a -> IO ()
throwErrnoIfMinus1_ [Char]
"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 ::
  ByteString {- ^ variable name  -} ->
  ByteString {- ^ variable value -} ->
  Bool       {- ^ overwrite      -} ->
  IO ()

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

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

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

-- | Computation 'getArgs' returns a list of the program's command
-- line arguments (not including the program name), as 'ByteString's.
--
-- Unlike 'System.Environment.getArgs', this function does no Unicode
-- decoding of the arguments; you get the exact bytes that were passed
-- to the program by the OS.  To interpret the arguments as text, some
-- Unicode decoding should be applied.
--
getArgs :: IO [ByteString]
getArgs :: IO [ByteString]
getArgs =
  (Ptr CInt -> IO [ByteString]) -> IO [ByteString]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO [ByteString]) -> IO [ByteString])
-> (Ptr CInt -> IO [ByteString]) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
p_argc ->
  (Ptr (Ptr CString) -> IO [ByteString]) -> IO [ByteString]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CString) -> IO [ByteString]) -> IO [ByteString])
-> (Ptr (Ptr CString) -> IO [ByteString]) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr CString)
p_argv -> do
   Ptr CInt -> Ptr (Ptr CString) -> IO ()
getProgArgv Ptr CInt
p_argc Ptr (Ptr CString)
p_argv
   Int
p    <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p_argc
   Ptr CString
argv <- Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CString)
p_argv
   Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Ptr CString -> Int -> Ptr CString
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CString
argv Int
1) IO [CString] -> ([CString] -> IO [ByteString]) -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO ByteString) -> [CString] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CString -> IO ByteString
B.packCString

foreign import ccall unsafe "getProgArgv"
  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()