    {- user info
     -
     - Copyright 2012 Joey Hess <id@joeyh.name>
     -
     - License: BSD-2-clause
     -}

    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -fno-warn-tabs #-}

    module Utility.UserInfo (
    	myHomeDir,
    	myUserName,
    	myUserGecos,
    ) where

    import Utility.Env.Basic
    import Utility.Exception
    #ifndef mingw32_HOST_OS
    import Utility.Data
    import Control.Applicative
    #endif

    import System.PosixCompat
    import Prelude

    {- Current user's home directory.
     -
     - getpwent will fail on LDAP or NIS, so use HOME if set. -}
    myHomeDir :: IO FilePath
    myHomeDir :: IO FilePath
    myHomeDir = (FilePath -> IO FilePath)
    -> (FilePath -> IO FilePath)
    -> Either FilePath FilePath
    -> IO FilePath
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either FilePath -> IO FilePath
    forall a. FilePath -> a
    giveup FilePath -> IO FilePath
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either FilePath FilePath -> IO FilePath)
    -> IO (Either FilePath FilePath) -> IO FilePath
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [FilePath]
    -> (UserEntry -> FilePath) -> IO (Either FilePath FilePath)
    myVal [FilePath]
    env UserEntry -> FilePath
    homeDirectory
      where
    #ifndef mingw32_HOST_OS
    	env :: [FilePath]
    env = ["HOME"]
    #else
    	env = ["USERPROFILE", "HOME"] -- HOME is used in Cygwin
    #endif

    {- Current user's user name. -}
    myUserName :: IO (Either String String)
    myUserName :: IO (Either FilePath FilePath)
    myUserName = [FilePath]
    -> (UserEntry -> FilePath) -> IO (Either FilePath FilePath)
    myVal [FilePath]
    env UserEntry -> FilePath
    userName
      where
    #ifndef mingw32_HOST_OS
    	env :: [FilePath]
    env = ["USER", "LOGNAME"]
    #else
    	env = ["USERNAME", "USER", "LOGNAME"]
    #endif

    myUserGecos :: IO (Maybe String)
    -- userGecos is not available on Windows.
    #if defined(mingw32_HOST_OS)
    myUserGecos = return Nothing
    #else
    myUserGecos :: IO (Maybe FilePath)
    myUserGecos = Either FilePath FilePath -> Maybe FilePath
    forall a b. Either a b -> Maybe b
    eitherToMaybe (Either FilePath FilePath -> Maybe FilePath)
    -> IO (Either FilePath FilePath) -> IO (Maybe FilePath)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [FilePath]
    -> (UserEntry -> FilePath) -> IO (Either FilePath FilePath)
    myVal [] UserEntry -> FilePath
    userGecos
    #endif

    myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
    myVal :: [FilePath]
    -> (UserEntry -> FilePath) -> IO (Either FilePath FilePath)
    myVal envvars :: [FilePath]
    envvars extract :: UserEntry -> FilePath
    extract = [FilePath] -> IO (Either FilePath FilePath)
    go [FilePath]
    envvars
      where
    	go :: [FilePath] -> IO (Either FilePath FilePath)
    go [] = (SomeException -> Either FilePath FilePath)
    -> (UserEntry -> Either FilePath FilePath)
    -> Either SomeException UserEntry
    -> Either FilePath FilePath
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Either FilePath FilePath
    -> SomeException -> Either FilePath FilePath
    forall a b. a -> b -> a
    const (Either FilePath FilePath
     -> SomeException -> Either FilePath FilePath)
    -> Either FilePath FilePath
    -> SomeException
    -> Either FilePath FilePath
    forall a b. (a -> b) -> a -> b
    $ Either FilePath FilePath
    forall b. Either FilePath b
    envnotset) (FilePath -> Either FilePath FilePath
    forall a b. b -> Either a b
    Right (FilePath -> Either FilePath FilePath)
    -> (UserEntry -> FilePath) -> UserEntry -> Either FilePath FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UserEntry -> FilePath
    extract) (Either SomeException UserEntry -> Either FilePath FilePath)
    -> IO (Either SomeException UserEntry)
    -> IO (Either FilePath FilePath)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Either SomeException UserEntry)
    get
    	go (v :: FilePath
    v:vs :: [FilePath]
    vs) = IO (Either FilePath FilePath)
    -> (FilePath -> IO (Either FilePath FilePath))
    -> Maybe FilePath
    -> IO (Either FilePath FilePath)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([FilePath] -> IO (Either FilePath FilePath)
    go [FilePath]
    vs) (Either FilePath FilePath -> IO (Either FilePath FilePath)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either FilePath FilePath -> IO (Either FilePath FilePath))
    -> (FilePath -> Either FilePath FilePath)
    -> FilePath
    -> IO (Either FilePath FilePath)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Either FilePath FilePath
    forall a b. b -> Either a b
    Right) (Maybe FilePath -> IO (Either FilePath FilePath))
    -> IO (Maybe FilePath) -> IO (Either FilePath FilePath)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< FilePath -> IO (Maybe FilePath)
    getEnv FilePath
    v
    #ifndef mingw32_HOST_OS
    	-- This may throw an exception if the system doesn't have a
    	-- passwd file etc; don't let it crash.
    	get :: IO (Either SomeException UserEntry)
    get = IO UserEntry -> IO (Either SomeException UserEntry)
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> m (Either SomeException a)
    tryNonAsync (IO UserEntry -> IO (Either SomeException UserEntry))
    -> IO UserEntry -> IO (Either SomeException UserEntry)
    forall a b. (a -> b) -> a -> b
    $ UserID -> IO UserEntry
    getUserEntryForID (UserID -> IO UserEntry) -> IO UserID -> IO UserEntry
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO UserID
    getEffectiveUserID
    #else
    	get = return envnotset
    #endif
    	envnotset :: Either FilePath b
    envnotset = FilePath -> Either FilePath b
    forall a b. a -> Either a b
    Left ("environment not set: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ [FilePath] -> FilePath
    forall a. Show a => a -> FilePath
    show [FilePath]
    envvars)