ghc-pkg needs settings file to un-hardcode target platform

This matches GHC itself getting the target platform from there.

2 files changed, 34 insertions, 5 deletions

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 02ac7d22d9..0e28ce9353 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -17,6 +17,9 @@
 #endif
 #endif
 
+-- Fine if this comes from make/Hadrian or the pre-built base.
+#include <ghcplatform.h>
+
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2004-2009.
@@ -27,11 +30,16 @@
 
 module Main (main) where
 
-import Version ( version, targetOS, targetARCH )
+import Version ( version )
 import qualified GHC.PackageDb as GhcPkg
 import GHC.PackageDb (BinaryStringRep(..))
 import GHC.HandleEncoding
 import GHC.BaseDir (getBaseDir)
+import GHC.Settings (getTargetPlatform, maybeReadFuzzy)
+import GHC.Platform
+  ( platformArch, platformOS
+  , stringEncodeArch, stringEncodeOS
+  )
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import qualified Data.Graph as Graph
 import qualified Distribution.ModuleName as ModuleName
@@ -592,14 +600,14 @@ getPkgDatabases :: Verbosity
                           -- commands that just read the DB, such as 'list'.
 
 getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
-  -- first we determine the location of the global package config.  On Windows,
+  -- Second we determine the location of the global package config.  On Windows,
   -- this is found relative to the ghc-pkg.exe binary, whereas on Unix the
   -- location is passed to the binary using the --global-package-db flag by the
   -- wrapper script.
   let err_msg = "missing --global-package-db option, location of global package database unknown\n"
   global_conf <-
      case [ f | FlagGlobalConfig f <- my_flags ] of
-        -- See note [Base Dir] for more information on the base dir / top dir.
+        -- See Note [Base Dir] for more information on the base dir / top dir.
         [] -> do mb_dir <- getBaseDir
                  case mb_dir of
                    Nothing  -> die err_msg
@@ -628,7 +636,25 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
       [] -> case e_appdir of
         Left _    -> return Nothing
         Right appdir -> do
-          let subdir = targetARCH ++ '-':targetOS ++ '-':Version.version
+          -- See Note [Settings File] about this file, and why we need GHC to share it with us.
+          let settingsFile = top_dir </> "settings"
+          exists_settings_file <- doesFileExist settingsFile
+          (arch, os) <- case exists_settings_file of
+            False -> do
+              warn $ "WARNING: settings file doesn't exist " ++ show settingsFile
+              warn "cannot know target platform so guessing target == host (native compiler)."
+              pure (HOST_ARCH, HOST_OS)
+            True -> do
+              settingsStr <- readFile settingsFile
+              mySettings <- case maybeReadFuzzy settingsStr of
+                Just s -> pure $ Map.fromList s
+                -- It's excusable to not have a settings file (for now at
+                -- least) but completely inexcusable to have a malformed one.
+                Nothing -> die $ "Can't parse settings file " ++ show settingsFile
+              case getTargetPlatform settingsFile mySettings of
+                Right platform -> pure (stringEncodeArch $ platformArch platform, stringEncodeOS $ platformOS platform)
+                Left e -> die e
+          let subdir = arch ++ '-':os ++ '-':Version.version
               dir = appdir </> subdir
           r <- lookForPackageDBIn dir
           case r of
diff --git a/utils/ghc-pkg/ghc.mk b/utils/ghc-pkg/ghc.mk
index a063e0b787..37ce0a7c5b 100644
--- a/utils/ghc-pkg/ghc.mk
+++ b/utils/ghc-pkg/ghc.mk
@@ -69,7 +69,10 @@ endif
 
 $(eval $(call build-prog,utils/ghc-pkg,dist,0))
 
-$(ghc-pkg_INPLACE) : | $(INPLACE_PACKAGE_CONF)/.
+# ghc-pkg uses `settings` to figure out the target platform to figure out a
+# subdirectory for the user pkg db. So make sure `settings` exists (alterative
+# is to specify global package db only.
+$(ghc-pkg_INPLACE) : | $(INPLACE_PACKAGE_CONF)/. $(INPLACE_LIB)/settings
 
 utils/ghc-pkg/dist/package-data.mk: \
     utils/ghc-pkg/dist/build/Version.hs