Moritz Angermann pushed to branch wip/angerman/ghc-pkg-target at Glasgow Haskell Compiler / GHC Commits: 6f006af5 by Moritz Angermann at 2025-09-06T16:22:32+09:00 ghc-pkg: Add support for --target This adds support to ghc-pkg to infer a package-db from a target name. - - - - - 1 changed file: - utils/ghc-pkg/Main.hs Changes: ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -151,6 +152,7 @@ data Flag | FlagVerbosity (Maybe String) | FlagUnitId | FlagShowUnitIds + | FlagTarget String deriving Eq flags :: [OptDescr Flag] @@ -198,7 +200,9 @@ flags = [ Option [] ["ipid", "unit-id"] (NoArg FlagUnitId) "interpret package arguments as unit IDs (e.g. installed package IDs)", Option ['v'] ["verbose"] (OptArg FlagVerbosity "Verbosity") - "verbosity level (0-2, default 1)" + "verbosity level (0-2, default 1)", + Option [] ["target"] (ReqArg FlagTarget "TARGET") + "run against the specified target (this has no effect if --global-package-db is specified)" ] data Verbosity = Silent | Normal | Verbose @@ -587,6 +591,29 @@ readFromSettingsFile settingsFile f = do Right archOS -> Right archOS Left e -> Left e +-- | Get the cross target. +-- +-- This is either extracted from the '--target' flag or inferred +-- from the current program name. +getTarget :: [Flag] -> IO (Maybe String) +getTarget my_flags = do + case [ t | FlagTarget t <- my_flags ] of + [] -> do + -- when no target is specified on the command line, infer it from the program name. + -- e.g. x86_64-unknown-linux-ghc-pkg + progN <- getProgName + if | "-ghc-pkg" `isSuffixOf` progN + , parts <- split '-' progN + , length parts > 3 -> pure (Just (take (length progN - 8) progN)) + | otherwise -> pure Nothing + ts -> pure (Just (last ts)) + where + split :: Char -> String -> [String] + split c s = case rest of + [] -> [chunk] + _:rest -> chunk : split c rest + where (chunk, rest) = break (==c) s + getPkgDatabases :: Verbosity -> GhcPkg.DbOpenMode mode DbModifySelector -> Bool -- use the user db @@ -616,7 +643,12 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do [] -> do mb_dir <- getBaseDir case mb_dir of Nothing -> die err_msg - Just dir -> do + Just dir' -> do + mt <- getTarget my_flags + dir <- case mt of + Nothing -> pure dir' + Just target -> pure (dir' "targets" target "lib") + -- Look for where it is given in the settings file, if marked there. let settingsFile = dir "settings" exists_settings_file <- doesFileExist settingsFile View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f006af520718c365b1d52c3361a4d45... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f006af520718c365b1d52c3361a4d45... You're receiving this email because of your account on gitlab.haskell.org.