-----------------------------------------------------------------------------
-- |
-- Module      :  System.Environment.UTF8
-- Copyright   :  (c) Dmitry Golubovsky, 2009
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  GHC, Unix
--
-- Miscellaneous information about the system environment, assuming it was
-- encoded in UTF-8. To be used as a drop-in replacement for System.Environment
--
-----------------------------------------------------------------------------
 
-- Portions of code suggested by Austin Seipp, 
-- http://haskell.org/pipermail/haskell-cafe/2009-March/057511.html
-- Haddock comments are borrowed from the original System.Environment module.

module System.Environment.UTF8
    (
      getArgs,       -- :: IO [String]
      getProgName,   -- :: IO String
      getEnv,        -- :: String -> IO String
      withArgs,
      withProgName,
      getEnvironment
  ) where

import Codec.Binary.UTF8.String
import qualified System.Environment as E
import Control.Monad

-- | Computation 'getArgs' returns a list of the program's command
-- line arguments (not including the program name).

getArgs :: IO [String]

getArgs = E.getArgs >>= mapM (return . decodeString)

{-|
 Computation 'getProgName' returns the name of the program as it was
 invoked.
 
 However, this is hard-to-impossible to implement on some non-Unix
 OSes, so instead, for maximum portability, we just return the leafname
 of the program as invoked. Even then there are some differences
 between platforms: on Windows, for example, a program invoked as foo
 is probably really @FOO.EXE@, and that is what 'getProgName' will return.
-}

getProgName :: IO String

getProgName = E.getProgName >>= return . decodeString

-- | Computation 'getEnv' @var@ returns the value
-- of the environment variable @var@.  
--
-- This computation may fail with:
--
--  * 'System.IO.Error.isDoesNotExistError' if the environment variable
--    does not exist.

getEnv :: String -> IO String

getEnv name = E.getEnv (encodeString name) >>= return . decodeString

{-|
 'withArgs' @args act@ - while executing action @act@, have 'getArgs'
 return @args@.
-}

withArgs :: [String] -> IO a -> IO a
withArgs xs act = E.withArgs (map encodeString xs) act

{-|
 'withProgName' @name act@ - while executing action @act@,
 have 'getProgName' return @name@.
-}

withProgName :: String -> IO a -> IO a
withProgName nm act = E.withProgName (encodeString nm) act

-- |'getEnvironment' retrieves the entire environment as a
-- list of @(key,value)@ pairs.
--
-- If an environment entry does not contain an @\'=\'@ character,
-- the @key@ is the whole entry and the @value@ is the empty string.

getEnvironment :: IO [(String, String)]

getEnvironment = do
  env <- E.getEnvironment
  let ks = map (decodeString . fst) env
      vs = map (decodeString . snd) env
  return $ zip ks vs