[Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Attempt to only change .conf file

[Rodrigo Mesquita (@alt-romes)]

Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC


Commits:
5694287d by romes at 2023-03-20T18:29:35+00:00
Attempt to only change .conf file

- - - - -


4 changed files:

- hadrian/src/Context.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Settings/Builders/Cabal.hs


Changes:

=====================================
hadrian/src/Context.hs
=====================================
@@ -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
     dbPath <- packageDbPath (PackageDbLoc stage iplace)
     return $ dbPath -/- pid <.> "conf"
 


=====================================
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
@@ -496,7 +495,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 . (\c -> c{Context.package = ghc}) =<< getContext
     return $ unlines
         [ "module GHC.Settings.Config"
         , "  ( module GHC.Version"


=====================================
hadrian/src/Rules/Register.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeApplications #-}
 module Rules.Register (
     configurePackageRules, registerPackageRules, registerPackages,
     libraryTargets
@@ -20,9 +21,13 @@ 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.Parsec.FieldLineStream as Cabal
+import qualified Distribution.Compat.CharParsing as CabalCharParsing
 import qualified Distribution.Types.PackageName as Cabal
 import qualified Distribution.Types.PackageId as Cabal
 
@@ -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 <- pkgSimpleIdentifier package
     files <- liftIO $
       (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"]
            <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"]
@@ -252,10 +257,28 @@ getPackageNameFromConfFile conf
         Right (name, _) -> return 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 $ pkgSimpleIdentifier pkg -- ROMES:TODO: This should really be pkgUnitId, but we can't because of recursive oracles. What do I do?
   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)@,



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5694287de77f72c76e2e6cafbaa7c5582913a30a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5694287de77f72c76e2e6cafbaa7c5582913a30a
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/8d1020cf/attachment-0001.html>