[Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Revert "Revert "If filepaths have hashes then cabal can't parse them""
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Mar 20 17:35:18 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC
Commits:
75a2f1fd by romes at 2023-03-20T17:35:05+00:00
Revert "Revert "If filepaths have hashes then cabal can't parse them""
This reverts commit 4aab197ed680cc5d192c4845c009c4bd1871535e.
- - - - -
15 changed files:
- hadrian/src/Context.hs
- hadrian/src/Hadrian/BuildPath.hs
- hadrian/src/Hadrian/Haskell/Cabal.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Hadrian/Haskell/Hash.hs-boot
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/Haddock.hs
Changes:
=====================================
hadrian/src/Context.hs
=====================================
@@ -70,15 +70,15 @@ distDir st = do
hostArch <- cabalArchString <$> setting arch
return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
-pkgFileName :: Package -> String -> String -> Action FilePath
-pkgFileName package prefix suffix = do
- pid <- pkgSimpleIdentifier package
+pkgFileName :: Context -> Package -> String -> String -> Action FilePath
+pkgFileName context package prefix suffix = do
+ pid <- pkgUnitId context package
return $ prefix ++ pid ++ suffix
pkgFile :: Context -> String -> String -> Action FilePath
pkgFile context at Context {..} prefix suffix = do
path <- buildPath context
- fileName <- pkgFileName package prefix suffix
+ fileName <- pkgFileName context package prefix suffix
return $ path -/- fileName
-- | Path to inplace package configuration file of a given 'Context'.
@@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
-- | Path to the haddock file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/doc/html/array/array.haddock at .
pkgHaddockFile :: Context -> Action FilePath
-pkgHaddockFile Context {..} = do
+pkgHaddockFile context at Context {..} = do
root <- buildRoot
- version <- pkgSimpleIdentifier package
+ version <- pkgUnitId context package
return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock"
-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
@@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do
pkgRegisteredLibraryFile :: Context -> Action FilePath
pkgRegisteredLibraryFile context at Context {..} = do
libDir <- libPath context
- pkgId <- pkgSimpleIdentifier package
+ pkgId <- pkgUnitId context package
fileName <- pkgRegisteredLibraryFileName context
distDir <- distDir stage
return $ if Dynamic `wayUnit` way
@@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do
-- | Just the final filename portion of pkgRegisteredLibraryFile
pkgRegisteredLibraryFileName :: Context -> Action FilePath
-pkgRegisteredLibraryFileName Context{..} = do
+pkgRegisteredLibraryFileName context at Context{..} = do
extension <- libsuf stage way
- pkgFileName package "libHS" extension
+ pkgFileName context package "libHS" extension
-- | Path to the library file of a given 'Context', e.g.:
@@ -137,7 +137,7 @@ pkgGhciLibraryFile context at Context {..} = do
-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
pkgConfFile context at Context {..} = do
- pid <- pkgSimpleIdentifier package
+ pid <- pkgUnitId context package
dbPath <- packageDbPath (PackageDbLoc stage iplace)
return $ dbPath -/- pid <.> "conf"
=====================================
hadrian/src/Hadrian/BuildPath.hs
=====================================
@@ -112,16 +112,19 @@ parseWayUnit = Parsec.choice
-- | Parse a @"pkgname-pkgversion"@ string into the package name and the
-- integers that make up the package version.
-parsePkgId :: Parsec.Parsec String () (String, [Integer])
+parsePkgId :: Parsec.Parsec String () (String, [Integer], String)
parsePkgId = parsePkgId' "" Parsec.<?> "package identifier (<name>-<version>)"
where
parsePkgId' currName = do
s <- Parsec.many1 Parsec.alphaNum
_ <- Parsec.char '-'
let newName = if null currName then s else currName ++ "-" ++ s
- Parsec.choice [ (newName,) <$> parsePkgVersion
+ Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash)
, parsePkgId' newName ]
+parsePkgHash :: Parsec.Parsec String () String
+parsePkgHash = Parsec.many1 Parsec.alphaNum
+
-- | Parse "."-separated integers that describe a package's version.
parsePkgVersion :: Parsec.Parsec String () [Integer]
parsePkgVersion = fmap reverse (parsePkgVersion' [])
=====================================
hadrian/src/Hadrian/Haskell/Cabal.hs
=====================================
@@ -10,7 +10,7 @@
-- Cabal files.
-----------------------------------------------------------------------------
module Hadrian.Haskell.Cabal (
- pkgVersion, pkgSimpleIdentifier, pkgUnitId, pkgSynopsis, pkgDescription,
+ pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription,
pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString
) where
@@ -27,18 +27,6 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId)
pkgVersion :: Package -> Action String
pkgVersion = fmap version . readPackageData
-
--- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at .
--- The Cabal file is tracked.
---
--- For an identifier complete with the hash use 'pkgUnitId'
-pkgSimpleIdentifier :: Package -> Action String
-pkgSimpleIdentifier package = do
- cabal <- readPackageData package
- return $ if null (version cabal)
- then name cabal
- else name cabal ++ "-" ++ version cabal
-
-- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
pkgSynopsis :: Package -> Action String
pkgSynopsis = fmap synopsis . readPackageData
=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -345,7 +345,7 @@ registerPackage rs context = do
pd <- packageDescription <$> readContextData context
db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context))
dist_dir <- Context.buildPath context
- pid <- pkgUnitId context
+ pid <- pkgUnitId context (package context)
-- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
-- from the local build info @lbi at .
lbi <- liftIO $ C.getPersistBuildConfig cPath
=====================================
hadrian/src/Hadrian/Haskell/Hash.hs
=====================================
@@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where
import Development.Shake
-import Hadrian.Haskell.Cabal.Type
+import Hadrian.Haskell.Cabal.Type as C
import Hadrian.Haskell.Cabal
import Hadrian.Oracles.Cabal
import Hadrian.Package
@@ -35,8 +35,9 @@ import Control.Monad
-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at .
-- This needs to be an oracle so it's cached
-pkgUnitId :: Context -> Action String
-pkgUnitId ctx = do
+pkgUnitId :: Context -> Package -> Action String
+pkgUnitId ctx' pkg = do
+ let ctx = ctx'{package = pkg}
pid <- pkgSimpleIdentifier (package ctx)
phash <- pkgHash ctx
-- Other boot packages still hardcode their unit-id to just <name>, but we
@@ -50,6 +51,16 @@ pkgUnitId ctx = do
truncateHash :: Int -> String -> String
truncateHash = take
+-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at .
+-- The Cabal file is tracked.
+--
+-- For an identifier complete with the hash use 'pkgUnitId'
+pkgSimpleIdentifier :: Package -> Action String
+pkgSimpleIdentifier package = do
+ cabal <- readPackageData package
+ return $ if null (version cabal)
+ then C.name cabal
+ else C.name cabal ++ "-" ++ version cabal
data PackageHashInputs = PackageHashInputs {
pkgHashPkgId :: String, -- ^ name-version
@@ -106,7 +117,7 @@ pkgHash = askOracle . PkgHashKey
-- TODO: Needs to be oracle to be cached? Called lots of times
pkgHashOracle :: Rules ()
pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
- ctx_data <- readContextData ctx
+ -- RECURSIVE ORACLE: ctx_data <- readContextData ctx
pkg_data <- readPackageData (package ctx)
name <- pkgSimpleIdentifier (package ctx)
let stag = stage ctx
@@ -141,8 +152,10 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
pkgHashStripLibs = False
pkgHashDebugInfo = undefined
- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs
- let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs
+ liftIO $ print "HI"
+ -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs
+ liftIO $ print "HI"
+ let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs
pkgHashExtraLibDirs = []
pkgHashExtraLibDirsStatic = []
pkgHashExtraFrameworkDirs = []
=====================================
hadrian/src/Hadrian/Haskell/Hash.hs-boot
=====================================
@@ -1,7 +1,8 @@
module Hadrian.Haskell.Hash where
import Context.Type
+import Hadrian.Package
import Development.Shake
-pkgUnitId :: Context -> Action String
+pkgUnitId :: Context -> Package -> Action String
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -132,7 +132,8 @@ bindistRules = do
version <- setting ProjectVersion
targetPlatform <- setting TargetPlatformFull
distDir <- Context.distDir Stage1
- rtsDir <- pkgSimpleIdentifier rts
+ -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts
+ let rtsDir = "rts"
let ghcBuildDir = root -/- stageString Stage1
bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty
=====================================
hadrian/src/Rules/CabalReinstall.hs
=====================================
@@ -10,7 +10,7 @@ import Utilities
import qualified System.Directory.Extra as IO
import Data.Either
import Rules.BinaryDist
-import Hadrian.Haskell.Cabal (pkgSimpleIdentifier)
+import Hadrian.Haskell.Cabal (pkgUnitId)
import Oracles.Setting
{-
@@ -54,7 +54,8 @@ cabalBuildRules = do
need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets)))
distDir <- Context.distDir Stage1
- rtsDir <- pkgSimpleIdentifier rts
+ -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts
+ let rtsDir = "rts"
let ghcBuildDir = root -/- stageString Stage1
rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -293,7 +293,7 @@ parsePkgDocTarget root = do
_ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
_ <- Parsec.string (htmlRoot ++ "/")
_ <- Parsec.string "libraries/"
- (pkgname, _) <- parsePkgId <* Parsec.char '/'
+ (pkgname, _, _) <- parsePkgId <* Parsec.char '/'
Parsec.choice
[ Parsec.try (Parsec.string "haddock-prologue.txt")
*> pure (HaddockPrologue pkgname)
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -15,7 +15,6 @@ import Oracles.ModuleFiles
import Oracles.Setting
import Hadrian.Haskell.Cabal.Type (PackageData(version))
import Hadrian.Haskell.Cabal
-import Hadrian.Haskell.Hash
import Hadrian.Oracles.Cabal (readPackageData)
import Packages
import Rules.Libffi
@@ -495,7 +494,7 @@ generateConfigHs = do
-- part of the WiringMap, so we don't to go back and forth between the
-- unit-id and the unit-key -- we take care that they are the same by using
-- 'pkgUnitId' to create the unit-id in both situations.
- cProjectUnitId <- expr . pkgUnitId =<< getContext
+ cProjectUnitId <- expr . (`pkgUnitId` ghc) =<< getContext
return $ unlines
[ "module GHC.Settings.Config"
, " ( module GHC.Version"
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -45,7 +45,7 @@ libraryRules = do
registerStaticLib :: FilePath -> FilePath -> Action ()
registerStaticLib root archivePath = do
-- Simply need the ghc-pkg database .conf file.
- GhcPkgPath _ stage _ (LibA name _ w)
+ GhcPkgPath _ stage _ (LibA name _ _ w)
<- parsePath (parseGhcPkgLibA root)
"<.a library (register) path parser>"
archivePath
@@ -56,7 +56,7 @@ registerStaticLib root archivePath = do
-- the second argument.
buildStaticLib :: FilePath -> FilePath -> Action ()
buildStaticLib root archivePath = do
- l@(BuildPath _ stage _ (LibA pkgname _ way))
+ l@(BuildPath _ stage _ (LibA pkgname _ _ way))
<- parsePath (parseBuildLibA root)
"<.a library (build) path parser>"
archivePath
@@ -75,7 +75,7 @@ buildStaticLib root archivePath = do
registerDynamicLib :: FilePath -> String -> FilePath -> Action ()
registerDynamicLib root suffix dynlibpath = do
-- Simply need the ghc-pkg database .conf file.
- (GhcPkgPath _ stage _ (LibDyn name _ w _))
+ (GhcPkgPath _ stage _ (LibDyn name _ _ w _))
<- parsePath (parseGhcPkgLibDyn root suffix)
"<dyn register lib parser>"
dynlibpath
@@ -99,7 +99,7 @@ buildDynamicLib root suffix dynlibpath = do
-- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
buildGhciLibO :: FilePath -> FilePath -> Action ()
buildGhciLibO root ghcilibPath = do
- l@(BuildPath _ stage _ (LibGhci _ _ _))
+ l@(BuildPath _ stage _ (LibGhci _ _ _ _))
<- parsePath (parseBuildLibGhci root)
"<.o ghci lib (build) path parser>"
ghcilibPath
@@ -134,7 +134,7 @@ files etc.
buildPackage :: FilePath -> FilePath -> Action ()
buildPackage root fp = do
- l@(BuildPath _ _ _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp
+ l@(BuildPath _ _ _ (PkgStamp _ _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp
let ctx = stampContext l
srcs <- hsSources ctx
gens <- interpretInContext ctx generatedDependencies
@@ -226,47 +226,47 @@ needLibrary cs = need =<< concatMapM (libraryTargets True) cs
-- * Library paths types and parsers
--- | > libHS<pkg name>-<pkg version>[_<way suffix>].a
-data LibA = LibA String [Integer] Way deriving (Eq, Show)
+-- | > libHS<pkg name>-<pkg version>-<pkg hash>[_<way suffix>].a
+data LibA = LibA String [Integer] String Way deriving (Eq, Show)
-- | > <so or dylib>
data DynLibExt = So | Dylib deriving (Eq, Show)
--- | > libHS<pkg name>-<pkg version>[_<way suffix>]-ghc<ghc version>.<so|dylib>
-data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show)
+-- | > libHS<pkg name>-<pkg version>-<pkg hash>[_<way suffix>]-ghc<ghc version>.<so|dylib>
+data LibDyn = LibDyn String [Integer] String Way DynLibExt deriving (Eq, Show)
--- | > HS<pkg name>-<pkg version>[_<way suffix>].o
-data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show)
+-- | > HS<pkg name>-<pkg version>-<pkg hash>[_<way suffix>].o
+data LibGhci = LibGhci String [Integer] String Way deriving (Eq, Show)
-- | Get the 'Context' corresponding to the build path for a given static library.
libAContext :: BuildPath LibA -> Context
-libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
+libAContext (BuildPath _ stage pkgpath (LibA pkgname _ _ way)) =
Context stage pkg way Final
where
pkg = library pkgname pkgpath
-- | Get the 'Context' corresponding to the build path for a given GHCi library.
libGhciContext :: BuildPath LibGhci -> Context
-libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =
+libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ _ way)) =
Context stage pkg way Final
where
pkg = library pkgname pkgpath
-- | Get the 'Context' corresponding to the build path for a given dynamic library.
libDynContext :: BuildPath LibDyn -> Context
-libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
+libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ _ way _)) =
Context stage pkg way Final
where
pkg = library pkgname pkgpath
-- | Get the 'Context' corresponding to the build path for a given static library.
stampContext :: BuildPath PkgStamp -> Context
-stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) =
+stampContext (BuildPath _ stage _ (PkgStamp pkgname _ _ way)) =
Context stage pkg way Final
where
pkg = unsafeFindPackageByName pkgname
-data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show)
+data PkgStamp = PkgStamp String [Integer] String Way deriving (Eq, Show)
-- | Parse a path to a ghci library to be built, making sure the path starts
@@ -313,34 +313,34 @@ parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext)
parseLibAFilename :: Parsec.Parsec String () LibA
parseLibAFilename = do
_ <- Parsec.string "libHS"
- (pkgname, pkgver) <- parsePkgId
+ (pkgname, pkgver, pkghash) <- parsePkgId
way <- parseWaySuffix vanilla
_ <- Parsec.string ".a"
- return (LibA pkgname pkgver way)
+ return (LibA pkgname pkgver pkghash way)
-- | Parse the filename of a ghci library to be built into a 'LibGhci' value.
parseLibGhciFilename :: Parsec.Parsec String () LibGhci
parseLibGhciFilename = do
_ <- Parsec.string "HS"
- (pkgname, pkgver) <- parsePkgId
+ (pkgname, pkgver, pkghash) <- parsePkgId
_ <- Parsec.string "."
way <- parseWayPrefix vanilla
_ <- Parsec.string "o"
- return (LibGhci pkgname pkgver way)
+ return (LibGhci pkgname pkgver pkghash way)
-- | Parse the filename of a dynamic library to be built into a 'LibDyn' value.
parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn
parseLibDynFilename ext = do
_ <- Parsec.string "libHS"
- (pkgname, pkgver) <- parsePkgId
+ (pkgname, pkgver, pkghash) <- parsePkgId
way <- addWayUnit Dynamic <$> parseWaySuffix dynamic
_ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
_ <- Parsec.string ("." ++ ext)
- return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
+ return (LibDyn pkgname pkgver pkghash way $ if ext == "so" then So else Dylib)
parseStamp :: Parsec.Parsec String () PkgStamp
parseStamp = do
_ <- Parsec.string "stamp-"
- (pkgname, pkgver) <- parsePkgId
+ (pkgname, pkgver, pkghash) <- parsePkgId
way <- parseWaySuffix vanilla
- return (PkgStamp pkgname pkgver way)
+ return (PkgStamp pkgname pkgver pkghash way)
=====================================
hadrian/src/Rules/Register.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeApplications #-}
module Rules.Register (
configurePackageRules, registerPackageRules, registerPackages,
libraryTargets
@@ -20,11 +21,15 @@ import Utilities
import Hadrian.Haskell.Cabal.Type
import qualified Text.Parsec as Parsec
import qualified Data.Set as Set
+import qualified Data.Char as Char
+import Data.Bifunctor (bimap)
import Distribution.Version (Version)
-import qualified Distribution.Parsec as Cabal
-import qualified Distribution.Types.PackageName as Cabal
import qualified Distribution.Types.PackageId as Cabal
+import qualified Distribution.Types.PackageName as Cabal
+import qualified Distribution.Parsec as Cabal
+import qualified Distribution.Parsec.FieldLineStream as Cabal
+import qualified Distribution.Compat.CharParsing as CabalCharParsing
import qualified Hadrian.Haskell.Cabal.Parse as Cabal
import qualified System.Directory as IO
@@ -183,7 +188,7 @@ buildConfFinal rs context at Context {..} _conf = do
-- so that if any change ends up modifying a library (but not its .conf
-- file), we still rebuild things that depend on it.
dir <- (-/-) <$> libPath context <*> distDir stage
- pkgid <- pkgSimpleIdentifier context
+ pkgid <- pkgUnitId context package
files <- liftIO $
(++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"]
<*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"]
@@ -193,7 +198,9 @@ buildConfInplace :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildConfInplace rs context at Context {..} _conf = do
depPkgIds <- cabalDependencies context
ensureConfigured context
+ liftIO $ print "OK1"
need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage Inplace) <&> (-/- pkgId <.> "conf")) depPkgIds
+ liftIO $ print "OK2"
path <- buildPath context
@@ -251,11 +258,32 @@ getPackageNameFromConfFile conf
takeBaseName conf ++ ": " ++ err
Right (name, _) -> return name
+-- | Parse a cabal-like name
parseCabalName :: String -> Either String (String, Version)
-parseCabalName = fmap f . Cabal.eitherParsec
+-- Try to parse a name with a hash, but otherwise parse a name without one.
+parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "<parseCabalName>" $ Cabal.fieldLineStreamFromString s)
+ <|> fmap f (Cabal.eitherParsec s)
where
f :: Cabal.PackageId -> (String, Version)
f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id)
+ -- Definition similar to 'Parsec PackageIdentifier' from Cabal but extended
+ -- with logic for parsing the hash (despite not returning it)
+ nameWithHashParser :: Cabal.ParsecParser (String, Version)
+ nameWithHashParser = Cabal.PP $ \_ -> do
+ xs' <- Parsec.sepBy component (Parsec.char '-')
+ case reverse xs' of
+ hash:version_str:xs ->
+ case Cabal.simpleParsec @Version version_str of
+ Nothing -> fail ("failed to parse a version from " <> version_str)
+ Just v ->
+ if not (null xs) && all (\c -> all (/= '.') c && not (all Char.isDigit c)) xs
+ then return $ (intercalate "-" (reverse xs), v)
+ else fail "all digits or a dot in a portion of package name"
+ _ -> fail "couldn't parse a hash, a version and a name"
+ where
+ component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.')
+
+
-- | Return extra library targets.
extraTargets :: Context -> Action [FilePath]
=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -86,7 +86,7 @@ commonCabalArgs stage = do
verbosity <- expr getVerbosity
ctx <- getContext
pkg <- getPackage
- package_id <- expr $ pkgSimpleIdentifier pkg
+ package_id <- expr $ pkgUnitId ctx pkg
let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..")
mconcat [ -- Don't strip libraries when cross compiling.
-- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -3,7 +3,6 @@
module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
import Hadrian.Haskell.Cabal
-import Hadrian.Haskell.Hash
import Hadrian.Haskell.Cabal.Type
import Flavour
@@ -15,7 +14,6 @@ import Rules.Libffi (libffiName)
import qualified Data.Set as Set
import System.Directory
import Data.Version.Extra
-import Hadrian.Haskell.Hash
ghcBuilderArgs :: Args
ghcBuilderArgs = mconcat
@@ -262,7 +260,7 @@ packageGhcArgs = do
-- building stage0 because we have a flag in compiler/ghc.cabal.in that is
-- sets `-this-unit-id ghc` when hadrian is building stage0, which will
-- overwrite this one.
- pkgId <- expr $ pkgUnitId ctx
+ pkgId <- expr $ pkgUnitId ctx package
mconcat [ arg "-hide-all-packages"
, arg "-no-user-package-db"
, arg "-package-env -"
=====================================
hadrian/src/Settings/Builders/Haddock.hs
=====================================
@@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat
version <- expr $ pkgVersion pkg
synopsis <- expr $ pkgSynopsis pkg
haddocks <- expr $ haddockDependencies context
- haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgSimpleIdentifier p | (p, h) <- haddocks]
+ haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks]
hVersion <- expr $ pkgVersion haddock
statsDir <- expr $ haddockStatsFilesDir
baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75a2f1fd30a499d41b6eead5b8143f030653d04e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75a2f1fd30a499d41b6eead5b8143f030653d04e
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230320/acde1078/attachment-0001.html>
More information about the ghc-commits
mailing list