fix build on windows

This commit is contained in:
Joey Hess 2023-08-01 17:38:59 -04:00
parent 3b825eb7a6
commit d76f088dc4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -28,22 +28,20 @@ import Prelude
- -
- getpwent will fail on LDAP or NIS, so use HOME if set. -} - getpwent will fail on LDAP or NIS, so use HOME if set. -}
myHomeDir :: IO FilePath myHomeDir :: IO FilePath
myHomeDir = either giveup return =<< myVal env homeDirectory myHomeDir = either giveup return =<<
where
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
env = ["HOME"] myVal ["HOME"] homeDirectory
#else #else
env = ["USERPROFILE", "HOME"] -- HOME is used in Cygwin myVal ["USERPROFILE", "HOME"] -- HOME is used in Cygwin
#endif #endif
{- Current user's user name. -} {- Current user's user name. -}
myUserName :: IO (Either String String) myUserName :: IO (Either String String)
myUserName = myVal env userName myUserName =
where
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
env = ["USER", "LOGNAME"] myVal ["USER", "LOGNAME"] userName
#else #else
env = ["USERNAME", "USER", "LOGNAME"] myVal ["USERNAME", "USER", "LOGNAME"]
#endif #endif
myUserGecos :: IO (Maybe String) myUserGecos :: IO (Maybe String)
@ -54,16 +52,20 @@ myUserGecos = return Nothing
myUserGecos = eitherToMaybe <$> myVal [] userGecos myUserGecos = eitherToMaybe <$> myVal [] userGecos
#endif #endif
#ifndef mingw32_HOST_OS
myVal :: [String] -> (UserEntry -> String) -> IO (Either String String) myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
myVal envvars extract = go envvars myVal envvars extract = go envvars
where where
go [] = either (const $ envnotset) (Right . extract) <$> get go [] = either (const $ envnotset) (Right . extract) <$> get
go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
#ifndef mingw32_HOST_OS
-- This may throw an exception if the system doesn't have a -- This may throw an exception if the system doesn't have a
-- passwd file etc; don't let it crash. -- passwd file etc; don't let it crash.
get = tryNonAsync $ getUserEntryForID =<< getEffectiveUserID get = tryNonAsync $ getUserEntryForID =<< getEffectiveUserID
#else #else
get = return envnotset myVal :: [String] -> IO (Either String String)
myVal envvars = go envvars
where
go [] = envnotset
go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
#endif #endif
envnotset = Left ("environment not set: " ++ show envvars) envnotset = Left ("environment not set: " ++ show envvars)