Zubin pushed to branch wip/26416 at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • hadrian/src/CommandLine.hs
    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

  • hadrian/src/Hadrian/Haskell/Hash.hs
    ... ... @@ -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

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help