@@ -200,6 +200,8 @@ setupEnv mResolveMissingGHC = do
200 200 201 201
executablePath <- liftIO getExecutablePath
202 202 203 +
utf8EnvVars <- getUtf8LocaleVars menv
204 + 203 205
envRef <- liftIO $ newIORef Map.empty
204 206
let getEnvOverride' es = do
205 207
m <- readIORef envRef
@@ -217,7 +219,7 @@ setupEnv mResolveMissingGHC = do
217 219
else id)
218 220 219 221
$ (if esLocaleUtf8 es
220 -
then Map.insert "LC_ALL" "C.UTF-8"
222 +
then Map.union utf8EnvVars
221 223
else id)
222 224 223 225
-- For reasoning and duplication, see: https://github.com/fpco/stack/issues/70
@@ -985,3 +987,137 @@ removeHaskellEnvVars =
985 987
Map.delete "HASKELL_PACKAGE_SANDBOX" .
986 988
Map.delete "HASKELL_PACKAGE_SANDBOXES" .
987 989
Map.delete "HASKELL_DIST_DIR"
990 + 991 +
-- | Get map of environment variables to set to change the locale's encoding to UTF-8
992 +
getUtf8LocaleVars
993 +
:: forall m env.
994 +
(MonadReader env m, HasPlatform env, MonadLogger m, MonadCatch m, MonadBaseControl IO m, MonadIO m)
995 +
=> EnvOverride -> m (Map Text Text)
996 +
getUtf8LocaleVars menv = do
997 +
Platform _ os <- asks getPlatform
998 +
if isWindows os
999 +
then
1000 +
-- On Windows, locale is controlled by the code page, so we don't set any environment
1001 +
-- variables.
1002 +
return
1003 +
Map.empty
1004 +
else do
1005 +
let checkedVars = map checkVar (Map.toList $ eoTextMap menv)
1006 +
-- List of environment variables that will need to be updated to set UTF-8 (because
1007 +
-- they currently do not specify UTF-8).
1008 +
needChangeVars = concatMap fst checkedVars
1009 +
-- Set of locale-related environment variables that have already have a value.
1010 +
existingVarNames = Set.unions (map snd checkedVars)
1011 +
-- True if a locale is already specified by one of the "global" locale variables.
1012 +
hasAnyExisting =
1013 +
or $
1014 +
map
1015 +
(`Set.member` existingVarNames)
1016 +
["LANG", "LANGUAGE", "LC_ALL"]
1017 +
if null needChangeVars && hasAnyExisting
1018 +
then
1019 +
-- If no variables need changes and at least one "global" variable is set, no
1020 +
-- changes to environment need to be made.
1021 +
return
1022 +
Map.empty
1023 +
else do
1024 +
-- Get a list of known locales by running @locale -a@.
1025 +
elocales <- tryProcessStdout Nothing menv "locale" ["-a"]
1026 +
let
1027 +
-- Filter the list to only include locales with UTF-8 encoding.
1028 +
utf8Locales =
1029 +
case elocales of
1030 +
Left _ -> []
1031 +
Right locales ->
1032 +
filter
1033 +
isUtf8Locale
1034 +
(T.lines $
1035 +
T.decodeUtf8With
1036 +
T.lenientDecode
1037 +
locales)
1038 +
mfallback = getFallbackLocale utf8Locales
1039 +
when
1040 +
(isNothing mfallback)
1041 +
($logWarn
1042 +
"Warning: unable to set locale to UTF-8 encoding; GHC may fail with 'invalid character'")
1043 +
let
1044 +
-- Get the new values of variables to adjust.
1045 +
changes =
1046 +
Map.unions $
1047 +
map
1048 +
(adjustedVarValue utf8Locales mfallback)
1049 +
needChangeVars
1050 +
-- Get the values of variables to add.
1051 +
adds
1052 +
| hasAnyExisting =
1053 +
-- If we already have a "global" variable, then nothing needs
1054 +
-- to be added.
1055 +
Map.empty
1056 +
| otherwise =
1057 +
-- If we don't already have a "global" variable, then set LANG to the
1058 +
-- fallback.
1059 +
case mfallback of
1060 +
Nothing -> Map.empty
1061 +
Just fallback ->
1062 +
Map.singleton "LANG" fallback
1063 +
return (Map.union changes adds)
1064 +
where
1065 +
-- Determines whether an environment variable is locale-related and, if so, whether it needs to
1066 +
-- be adjusted.
1067 +
checkVar
1068 +
:: (Text, Text) -> ([Text], Set Text)
1069 +
checkVar (k,v) =
1070 +
if k `elem` ["LANG", "LANGUAGE"] || "LC_" `T.isPrefixOf` k
1071 +
then if isUtf8Locale v
1072 +
then ([], Set.singleton k)
1073 +
else ([k], Set.singleton k)
1074 +
else ([], Set.empty)
1075 +
-- Adjusted value of an existing locale variable. Looks for valid UTF-8 encodings with
1076 +
-- same language /and/ territory, then with same language, and finally the first UTF-8 locale
1077 +
-- returned by @locale -a@.
1078 +
adjustedVarValue
1079 +
:: [Text] -> Maybe Text -> Text -> Map Text Text
1080 +
adjustedVarValue utf8Locales mfallback k =
1081 +
case Map.lookup k (eoTextMap menv) of
1082 +
Nothing -> Map.empty
1083 +
Just v ->
1084 +
case concatMap
1085 +
(matchingLocales utf8Locales)
1086 +
[ T.takeWhile (/= '.') v <> "."
1087 +
, T.takeWhile (/= '_') v <> "_"] of
1088 +
(v':_) -> Map.singleton k v'
1089 +
[] ->
1090 +
case mfallback of
1091 +
Just fallback -> Map.singleton k fallback
1092 +
Nothing -> Map.empty
1093 +
-- Determine the fallback locale, by looking for any UTF-8 locale prefixed with the list in
1094 +
-- @fallbackPrefixes@, and if not found, picking the first UTF-8 encoding returned by @locale
1095 +
-- -a@.
1096 +
getFallbackLocale
1097 +
:: [Text] -> Maybe Text
1098 +
getFallbackLocale utf8Locales = do
1099 +
case concatMap (matchingLocales utf8Locales) fallbackPrefixes of
1100 +
(v:_) -> Just v
1101 +
[] ->
1102 +
case utf8Locales of
1103 +
[] -> Nothing
1104 +
(v:_) -> Just v
1105 +
-- Filter the list of locales for any with the given prefixes (case-insitive).
1106 +
matchingLocales
1107 +
:: [Text] -> Text -> [Text]
1108 +
matchingLocales utf8Locales prefix =
1109 +
filter
1110 +
(\v ->
1111 +
(T.toLower prefix) `T.isPrefixOf` T.toLower v)
1112 +
utf8Locales
1113 +
-- Does the locale have one of the encodings in @utf8Suffixes@ (case-insensitive)?
1114 +
isUtf8Locale locale =
1115 +
or $
1116 +
map
1117 +
(\v ->
1118 +
T.toLower v `T.isSuffixOf` T.toLower locale)
1119 +
utf8Suffixes
1120 +
-- Prefixes of fallback locales (case-insensitive)
1121 +
fallbackPrefixes = ["C.", "en_US.", "en_"]
1122 +
-- Suffixes of UTF-8 locales (case-insensitive)
1123 +
utf8Suffixes = [".UTF-8", ".utf8"]
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4