Zubin pushed to branch wip/26416 at Glasgow Haskell Compiler / GHC
WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below.
Deleted commits:
-
046abdcd
by Zubin Duggal at 2026-02-17T17:56:16+05:30
2 changed files:
Changes:
| 1 | 1 | module CommandLine (
|
| 2 | 2 | optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, lookupFreeze2, lookupSkipDepends,
|
| 3 | 3 | cmdBignum, cmdBignumCheck, cmdProgressInfo, cmdCompleteSetting,
|
| 4 | - cmdDocsArgs, cmdUnitIdHash, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs,
|
|
| 4 | + cmdDocsArgs, cmdUnitIdHash, cmdDebugHashInputs, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs,
|
|
| 5 | 5 | cmdPrefix, DocArgs(..), defaultDocArgs
|
| 6 | 6 | ) where
|
| 7 | 7 | |
| ... | ... | @@ -37,7 +37,8 @@ data CommandLineArgs = CommandLineArgs |
| 37 | 37 | , docsArgs :: DocArgs
|
| 38 | 38 | , docTargets :: DocTargets
|
| 39 | 39 | , prefix :: Maybe FilePath
|
| 40 | - , completeStg :: Maybe String }
|
|
| 40 | + , completeStg :: Maybe String
|
|
| 41 | + , debugHashInputs :: Bool }
|
|
| 41 | 42 | deriving (Eq, Show)
|
| 42 | 43 | |
| 43 | 44 | -- | Default values for 'CommandLineArgs'.
|
| ... | ... | @@ -57,7 +58,8 @@ defaultCommandLineArgs = CommandLineArgs |
| 57 | 58 | , docsArgs = defaultDocArgs
|
| 58 | 59 | , docTargets = Set.fromList [minBound..maxBound]
|
| 59 | 60 | , prefix = Nothing
|
| 60 | - , completeStg = Nothing }
|
|
| 61 | + , completeStg = Nothing
|
|
| 62 | + , debugHashInputs = False }
|
|
| 61 | 63 | |
| 62 | 64 | -- | These arguments are used by the `test` target.
|
| 63 | 65 | data TestArgs = TestArgs
|
| ... | ... | @@ -143,6 +145,9 @@ readUnitIdHash = Right $ \flags -> |
| 143 | 145 | trace "--hash-unit-ids is deprecated. It is enabled by release flavour or +hash_unit_ids flavour transformer" $
|
| 144 | 146 | flags { unitIdHash = True }
|
| 145 | 147 | |
| 148 | +readDebugHashInputs :: Either String (CommandLineArgs -> CommandLineArgs)
|
|
| 149 | +readDebugHashInputs = Right $ \flags -> flags { debugHashInputs = True }
|
|
| 150 | + |
|
| 146 | 151 | readProgressInfo :: String -> Either String (CommandLineArgs -> CommandLineArgs)
|
| 147 | 152 | readProgressInfo ms =
|
| 148 | 153 | case lower ms of
|
| ... | ... | @@ -278,6 +283,8 @@ optDescrs = |
| 278 | 283 | "Freeze Stage2 GHC."
|
| 279 | 284 | , Option [] ["hash-unit-ids"] (NoArg readUnitIdHash)
|
| 280 | 285 | "Include package hashes in unit ids."
|
| 286 | + , Option [] ["debug-hash-inputs"] (NoArg readDebugHashInputs)
|
|
| 287 | + "Debug: print and log hash inputs for each package."
|
|
| 281 | 288 | , Option [] ["skip-depends"] (NoArg readSkipDepends)
|
| 282 | 289 | "Skip rebuilding dependency information."
|
| 283 | 290 | , Option [] ["bignum"] (OptArg readBignum "BACKEND")
|
| ... | ... | @@ -401,5 +408,8 @@ cmdBignumCheck = bignumCheck <$> cmdLineArgs |
| 401 | 408 | cmdProgressInfo :: Action ProgressInfo
|
| 402 | 409 | cmdProgressInfo = progressInfo <$> cmdLineArgs
|
| 403 | 410 | |
| 411 | +cmdDebugHashInputs :: Action Bool
|
|
| 412 | +cmdDebugHashInputs = debugHashInputs <$> cmdLineArgs
|
|
| 413 | + |
|
| 404 | 414 | cmdDocsArgs :: Action DocTargets
|
| 405 | 415 | cmdDocsArgs = docTargets <$> cmdLineArgs |
| ... | ... | @@ -34,6 +34,8 @@ import Control.Monad |
| 34 | 34 | import Base
|
| 35 | 35 | import System.Directory.Extra (listFilesRecursive)
|
| 36 | 36 | import Control.Arrow (first)
|
| 37 | +import CommandLine (cmdDebugHashInputs)
|
|
| 38 | +import System.Directory (createDirectoryIfMissing)
|
|
| 37 | 39 | |
| 38 | 40 | |
| 39 | 41 | -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd@.
|
| ... | ... | @@ -169,15 +171,25 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey (stag, pkg)) -> do |
| 169 | 171 | need files
|
| 170 | 172 | files_hash <- liftIO (SHA256.finalize <$> hashFiles (SHA256.init) files)
|
| 171 | 173 | |
| 172 | - return $ BS.unpack $ Base16.encode $ SHA256.hash $
|
|
| 173 | - renderPackageHashInputs $ PackageHashInputs
|
|
| 174 | - {
|
|
| 175 | - pkgHashPkgId = name
|
|
| 176 | - , pkgHashComponent = pkgType pkg
|
|
| 177 | - , pkgHashSourceHash = files_hash
|
|
| 178 | - , pkgHashDirectDeps = Set.fromList depsHashes
|
|
| 179 | - , pkgHashOtherConfig = other_config
|
|
| 180 | - }
|
|
| 174 | + let hashInputs = PackageHashInputs
|
|
| 175 | + { pkgHashPkgId = name
|
|
| 176 | + , pkgHashComponent = pkgType pkg
|
|
| 177 | + , pkgHashSourceHash = files_hash
|
|
| 178 | + , pkgHashDirectDeps = Set.fromList depsHashes
|
|
| 179 | + , pkgHashOtherConfig = other_config
|
|
| 180 | + }
|
|
| 181 | + rendered = renderPackageHashInputs hashInputs
|
|
| 182 | + |
|
| 183 | + debugHash <- cmdDebugHashInputs
|
|
| 184 | + when debugHash $ do
|
|
| 185 | + root <- buildRoot
|
|
| 186 | + let debugDir = root -/- "hash-inputs"
|
|
| 187 | + debugFile = debugDir -/- name <.> "txt"
|
|
| 188 | + liftIO $ createDirectoryIfMissing True debugDir
|
|
| 189 | + liftIO $ BS.writeFile debugFile rendered
|
|
| 190 | + putNormal $ "Hash inputs for " ++ name ++ ":\n" ++ BS.unpack rendered
|
|
| 191 | + |
|
| 192 | + return $ BS.unpack $ Base16.encode $ SHA256.hash rendered
|
|
| 181 | 193 | |
| 182 | 194 | allFilesInDirectory :: FilePath -> Action [FilePath]
|
| 183 | 195 | allFilesInDirectory dir = liftIO $ listFilesRecursive dir
|