{-# LINE 1 "System/Posix/Env/PosixString.hsc" #-}
{-# LANGUAGE CApiFFI #-}

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

       -- * Program arguments
       , getArgs
) where



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

import GHC.IO.Encoding.UTF8 ( mkUTF8 )
import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
import System.Posix.Env ( clearEnv )
import System.OsPath.Posix
import System.OsString.Internal.Types
import qualified System.OsPath.Data.ByteString.Short as B
import Data.ByteString.Short.Internal ( copyToPtr )

import qualified System.Posix.Env.Internal as Internal

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

getEnv ::
  PosixString            {- ^ variable name  -} ->
  IO (Maybe PosixString) {- ^ variable value -}
getEnv :: PosixString -> IO (Maybe PosixString)
getEnv (PS ShortByteString
name) = do
  CString
litstring <- ShortByteString -> (CString -> IO CString) -> IO CString
forall a. ShortByteString -> (CString -> IO a) -> IO a
B.useAsCString ShortByteString
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 (PosixString -> Maybe PosixString
forall a. a -> Maybe a
Just (PosixString -> Maybe PosixString)
-> (ShortByteString -> PosixString)
-> ShortByteString
-> Maybe PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PosixString
PS) (ShortByteString -> Maybe PosixString)
-> IO ShortByteString -> IO (Maybe PosixString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ShortByteString
B.packCString CString
litstring
     else Maybe PosixString -> IO (Maybe PosixString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PosixString
forall a. Maybe a
Nothing

-- |'getEnvDefault' is a wrapper around 'getEnv' where the
-- programmer can specify a fallback as the second argument, which will be
-- used if the variable is not found in the environment.

getEnvDefault ::
  PosixString    {- ^ variable name                    -} ->
  PosixString    {- ^ fallback value                   -} ->
  IO PosixString {- ^ variable value or fallback value -}
getEnvDefault :: PosixString -> PosixString -> IO PosixString
getEnvDefault PosixString
name PosixString
fallback = PosixString -> Maybe PosixString -> PosixString
forall a. a -> Maybe a -> a
fromMaybe PosixString
fallback (Maybe PosixString -> PosixString)
-> IO (Maybe PosixString) -> IO PosixString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosixString -> IO (Maybe PosixString)
getEnv PosixString
name

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

getEnvironmentPrim :: IO [PosixString]
getEnvironmentPrim :: IO [PosixString]
getEnvironmentPrim = IO [CString]
Internal.getEnvironmentPrim IO [CString] -> ([CString] -> IO [PosixString]) -> IO [PosixString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO PosixString) -> [CString] -> IO [PosixString]
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 ((ShortByteString -> PosixString)
-> IO ShortByteString -> IO PosixString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> PosixString
PS (IO ShortByteString -> IO PosixString)
-> (CString -> IO ShortByteString) -> CString -> IO PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ShortByteString
B.packCString)

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

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

-- |'setEnvironment' resets the entire environment to the given list of
-- @(key,value)@ pairs.
setEnvironment ::
  [(PosixString,PosixString)] {- ^ @[(key,value)]@ -} ->
  IO ()
setEnvironment :: [(PosixString, PosixString)] -> IO ()
setEnvironment [(PosixString, PosixString)]
env = do
  IO ()
clearEnv
  [(PosixString, PosixString)]
-> ((PosixString, PosixString) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(PosixString, PosixString)]
env (((PosixString, PosixString) -> IO ()) -> IO ())
-> ((PosixString, PosixString) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(PosixString
key,PosixString
value) ->
    PosixString -> PosixString -> Bool -> IO ()
setEnv PosixString
key PosixString
value Bool
True {-overwrite-}

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

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

{-# LINE 104 "System/Posix/Env/PosixString.hsc" #-}

unsetEnv :: PosixString -> IO ()
{-# LINE 105 "System/Posix/Env/PosixString.hsc" #-}
unsetEnv (PS 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 118 "System/Posix/Env/PosixString.hsc" #-}

{-# LINE 121 "System/Posix/Env/PosixString.hsc" #-}

-- |'putEnv' function takes an argument of the form @name=value@
-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
putEnv :: PosixString {- ^ "key=value" -} -> IO ()
putEnv :: PosixString -> IO ()
putEnv (PS ShortByteString
sbs) = do
  CString
buf <- Int -> IO CString
forall a. Int -> IO (Ptr a)
mallocBytes (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  ShortByteString -> Int -> CString -> Int -> IO ()
forall a. ShortByteString -> Int -> Ptr a -> Int -> IO ()
copyToPtr ShortByteString
sbs Int
0 CString
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
  CString -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff CString
buf Int
l (Word8
0::Word8)
  [Char] -> IO CInt -> IO ()
forall a. (Eq a, Num a) => [Char] -> IO a -> IO ()
throwErrnoIfMinus1_ [Char]
"putenv" (CString -> IO CInt
c_putenv CString
buf)
 where l :: Int
l = ShortByteString -> Int
B.length ShortByteString
sbs


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 ::
  PosixString {- ^ variable name  -} ->
  PosixString {- ^ variable value -} ->
  Bool       {- ^ overwrite      -} ->
  IO ()

{-# LINE 149 "System/Posix/Env/PosixString.hsc" #-}
setEnv (PS key) (PS 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 "System/Posix/Env/PosixString.hsc" #-}

-- | Computation 'getArgs' returns a list of the program's command
-- line arguments (not including the program name), as 'PosixString'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 [PosixString]
getArgs :: IO [PosixString]
getArgs =
  (Ptr CInt -> IO [PosixString]) -> IO [PosixString]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO [PosixString]) -> IO [PosixString])
-> (Ptr CInt -> IO [PosixString]) -> IO [PosixString]
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
p_argc ->
  (Ptr (Ptr CString) -> IO [PosixString]) -> IO [PosixString]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CString) -> IO [PosixString]) -> IO [PosixString])
-> (Ptr (Ptr CString) -> IO [PosixString]) -> IO [PosixString]
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 [PosixString]) -> IO [PosixString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO PosixString) -> [CString] -> IO [PosixString]
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 ((ShortByteString -> PosixString)
-> IO ShortByteString -> IO PosixString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> PosixString
PS (IO ShortByteString -> IO PosixString)
-> (CString -> IO ShortByteString) -> CString -> IO PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ShortByteString
B.packCString)

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

_equal :: Word8
_equal :: Word8
_equal = Word8
0x3d

_toStr :: B.ShortByteString -> String
_toStr :: ShortByteString -> [Char]
_toStr = (EncodingException -> [Char])
-> ([Char] -> [Char]) -> Either EncodingException [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char])
-> (EncodingException -> [Char]) -> EncodingException -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> [Char]
forall a. Show a => a -> [Char]
show) [Char] -> [Char]
forall a. a -> a
id (Either EncodingException [Char] -> [Char])
-> (ShortByteString -> Either EncodingException [Char])
-> ShortByteString
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> PosixString -> Either EncodingException [Char]
decodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure) (PosixString -> Either EncodingException [Char])
-> (ShortByteString -> PosixString)
-> ShortByteString
-> Either EncodingException [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PosixString
PosixString