summaryrefslogtreecommitdiff
path: root/src/Utility/UserInfo.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utility/UserInfo.hs')
-rw-r--r--src/Utility/UserInfo.hs22
1 files changed, 14 insertions, 8 deletions
diff --git a/src/Utility/UserInfo.hs b/src/Utility/UserInfo.hs
index dd66c331..17ce8db5 100644
--- a/src/Utility/UserInfo.hs
+++ b/src/Utility/UserInfo.hs
@@ -14,12 +14,14 @@ module Utility.UserInfo (
myUserGecos,
) where
-import Utility.Env
-import Utility.Data
+import Utility.Env.Basic
import Utility.Exception
+#ifndef mingw32_HOST_OS
+import Utility.Data
+import Control.Applicative
+#endif
import System.PosixCompat
-import Control.Applicative
import Prelude
{- Current user's home directory.
@@ -45,8 +47,8 @@ myUserName = myVal env userName
#endif
myUserGecos :: IO (Maybe String)
--- userGecos crashes on Android and is not available on Windows.
-#if defined(__ANDROID__) || defined(mingw32_HOST_OS)
+-- userGecos is not available on Windows.
+#if defined(mingw32_HOST_OS)
myUserGecos = return Nothing
#else
myUserGecos = eitherToMaybe <$> myVal [] userGecos
@@ -55,9 +57,13 @@ myUserGecos = eitherToMaybe <$> myVal [] userGecos
myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
myVal envvars extract = go envvars
where
+ go [] = either (const $ envnotset) (Right . extract) <$> get
+ go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
#ifndef mingw32_HOST_OS
- go [] = Right . extract <$> (getUserEntryForID =<< getEffectiveUserID)
+ -- This may throw an exception if the system doesn't have a
+ -- passwd file etc; don't let it crash.
+ get = tryNonAsync $ getUserEntryForID =<< getEffectiveUserID
#else
- go [] = return $ Left ("environment not set: " ++ show envvars)
+ get = return envnotset
#endif
- go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
+ envnotset = Left ("environment not set: " ++ show envvars)