Skip to content

Commit 7e50837

Browse files
angermanangerman
committed
Fixup compiler id in pkgid
1 parent df70cef commit 7e50837

File tree

5 files changed

+26
-14
lines changed

5 files changed

+26
-14
lines changed

‎Cabal-syntax/src/Distribution/Parsec.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -96,7 +96,7 @@ class (P.CharParsing m, MonadPlus m, Fail.MonadFail m) => CabalParsing m where
9696
askCabalSpecVersion :: m CabalSpecVersion
9797

9898
-- | 'parsec' /could/ consume trailing spaces, this function /will/ consume.
99-
lexemeParsec :: (CabalParsing m, Parsec a) => m a
99+
lexemeParsec :: (HasCallStack, CabalParsing m, Parsec a) => m a
100100
lexemeParsec = parsec <* P.spaces
101101

102102
newtype ParsecParser a = PP
@@ -177,14 +177,14 @@ instance CabalParsing ParsecParser where
177177
askCabalSpecVersion = PP pure
178178

179179
-- | Parse a 'String' with 'lexemeParsec'.
180-
simpleParsec :: Parsec a => String -> Maybe a
180+
simpleParsec :: (HasCallStack, Parsec a) => String -> Maybe a
181181
simpleParsec =
182182
either (const Nothing) Just
183183
. runParsecParser lexemeParsec "<simpleParsec>"
184184
. fieldLineStreamFromString
185185

186186
-- | Like 'simpleParsec' but for 'ByteString'
187-
simpleParsecBS :: Parsec a => ByteString -> Maybe a
187+
simpleParsecBS :: (HasCallStack, Parsec a) => ByteString -> Maybe a
188188
simpleParsecBS =
189189
either (const Nothing) Just
190190
. runParsecParser lexemeParsec "<simpleParsec>"
@@ -193,7 +193,7 @@ simpleParsecBS =
193193
-- | Parse a 'String' with 'lexemeParsec' using specific 'CabalSpecVersion'.
194194
--
195195
-- @since 3.4.0.0
196-
simpleParsec' :: Parsec a => CabalSpecVersion -> String -> Maybe a
196+
simpleParsec' :: (HasCallStack, Parsec a) => CabalSpecVersion -> String -> Maybe a
197197
simpleParsec' spec =
198198
either (const Nothing) Just
199199
. runParsecParser' spec lexemeParsec "<simpleParsec>"
@@ -203,7 +203,7 @@ simpleParsec' spec =
203203
-- Fail if there are any warnings.
204204
--
205205
-- @since 3.4.0.0
206-
simpleParsecW' :: Parsec a => CabalSpecVersion -> String -> Maybe a
206+
simpleParsecW' :: (HasCallStack, Parsec a) => CabalSpecVersion -> String -> Maybe a
207207
simpleParsecW' spec =
208208
either (const Nothing) (\(x, ws) -> if null ws then Just x else Nothing)
209209
. runParsecParser' spec ((,) <$> lexemeParsec <*> liftParsec Parsec.getState) "<simpleParsec>"

‎Cabal-syntax/src/Distribution/Types/ComponentId.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import Distribution.Pretty
1717
import qualified Distribution.Compat.CharParsing as P
1818
import Text.PrettyPrint (text)
1919

20-
import GHC.Stack (HasCallStack)
20+
import GHC.Stack (HasCallStack, prettyCallStack, callStack)
2121
-- | A 'ComponentId' uniquely identifies the transitive source
2222
-- code closure of a component (i.e. libraries, executables).
2323
--
@@ -31,7 +31,7 @@ import GHC.Stack (HasCallStack)
3131
-- This type is opaque since @Cabal-2.0@
3232
--
3333
-- @since 2.0.0.2
34-
data ComponentId = ComponentId ShortText ShortText Bool
34+
data ComponentId = ComponentId {unitComp :: ShortText, unitId :: ShortText, wasPartial :: Bool }
3535
| PartialComponentId ShortText
3636
deriving (Generic, Read, Show, Data)
3737

@@ -57,11 +57,13 @@ instance Ord ComponentId where
5757
-- @since 2.0.0.2
5858
mkComponentId :: HasCallStack => String -> ComponentId
5959
mkComponentId s = case (simpleParsec s) of
60+
-- Just cid@ComponentId{ unitComp = c, unitId = i } | (fromShortText c) == "ghc-9.8.4", (fromShortText i) == "rts-1.0.3-cec100dd" -> trace ("### ComponentId: `" ++ (fromShortText c) ++ "' `" ++ (fromShortText i) ++ "' is a full one.\n" ++ prettyCallStack callStack) cid
6061
Just cid@ComponentId{} -> cid
6162
Just cid@PartialComponentId{} -> error $ "mkPartialComponentId: `" ++ s ++ "' is a partial component id, not a full one."
6263
_ -> error $ "Unable to parse PartialComponentId: `" ++ s ++ "'."
6364

6465
mkComponentId' :: HasCallStack => String -> String -> Bool -> ComponentId
66+
-- mkComponentId' c i b | c == "ghc-9.8.4", i == "rts-1.0.3-cec100dd" = trace ("### mkComponentId': `" ++ c ++ "' `" ++ i ++ "' is a full one.\n" ++ prettyCallStack callStack) (ComponentId (toShortText c) (toShortText i) b)
6567
mkComponentId' c i b = ComponentId (toShortText c) (toShortText i) b
6668

6769
mkPartialComponentId :: HasCallStack => String -> ComponentId

‎Cabal-syntax/src/Distribution/Types/UnitId.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ import Unsafe.Coerce (unsafeCoerce)
7373
-- representation of a UnitId to pass, e.g., as a @-package-id@
7474
-- flag, use the 'display' function, which will work on all
7575
-- versions of Cabal.
76-
data UnitId = UnitId ShortText ShortText Bool
76+
data UnitId = UnitId {unitComp :: ShortText, unitId :: ShortText, wasPartial :: Bool }
7777
| PartialUnitId ShortText
7878
deriving (Generic, Read, Show, Data)
7979

@@ -140,12 +140,13 @@ unUnitId (PartialUnitId s) = fromShortText s
140140

141141
mkUnitId :: HasCallStack => String -> UnitId
142142
mkUnitId s = case (simpleParsec s) of
143+
-- Just uid@UnitId{ unitComp = c, unitId = i } | (fromShortText c) == "ghc-9.8.4", (fromShortText i) == "rts-1.0.3-cec100dd" -> trace ("### mkUnitId: `" ++ (fromShortText c) ++ "' `" ++ (fromShortText i) ++ "' is a full one.\n" ++ prettyCallStack callStack) uid
143144
Just uid@UnitId{} -> uid
144145
Just uid@PartialUnitId{} -> uid -- error $ "mkUnitId: `" ++ s ++ "' is a partial unit id, not a full one."
145146
_ -> error $ "Unable to parse UnitId: `" ++ s ++ "'."
146147

147148
mkUnitId' :: HasCallStack => String -> String -> Bool -> UnitId
148-
-- mkUnitId' c i b | c == "ghc-9.8.4", i == "process-1.6.25.0-inplace" = trace ("### mkUnitId': `" ++ c ++ "' `" ++ i ++ "' is a full one.\n" ++ prettyCallStack callStack) (UnitId (toShortText c) (toShortText i) b)
149+
-- mkUnitId' c i b | c == "ghc-9.8.4", i == "rts-1.0.3-cec100dd" = trace ("### mkUnitId': `" ++ c ++ "' `" ++ i ++ "' is a full one.\n" ++ prettyCallStack callStack) (UnitId (toShortText c) (toShortText i) b)
149150
mkUnitId' c i b = UnitId (toShortText c) (toShortText i) b
150151

151152
mkPartialUnitId :: HasCallStack => String -> UnitId

‎cabal-install/src/Distribution/Client/PackageHash.hs‎

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -93,11 +93,14 @@ hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId
9393
hashedInstalledPackageIdLong
9494
pkghashinputs@PackageHashInputs{pkgHashPkgId, pkgHashComponent} =
9595
mkComponentId $
96-
prettyShow pkgHashPkgId -- to be a bit user friendly
96+
prettyShow compid
97+
++ "_"
98+
++ prettyShow pkgHashPkgId -- to be a bit user friendly
9799
++ maybe "" displayComponent pkgHashComponent
98100
++ "-"
99101
++ showHashValue (hashPackageHashInputs pkghashinputs)
100102
where
103+
PackageIdentifier name version (Just compid) = pkgHashPkgId
101104
displayComponent :: CD.Component -> String
102105
displayComponent CD.ComponentLib = ""
103106
displayComponent (CD.ComponentSubLib s) = "-l-" ++ prettyShow s
@@ -127,15 +130,17 @@ hashedInstalledPackageIdLong
127130
hashedInstalledPackageIdShort :: HasCallStack => PackageHashInputs -> InstalledPackageId
128131
hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
129132
mkComponentId $
130-
intercalate
133+
prettyShow compid
134+
++
135+
'_':intercalate
131136
"-"
132137
-- max length now 64
133138
[ truncateStr 14 (prettyShow name)
134139
, truncateStr 8 (prettyShow version)
135140
, showHashValue (truncateHash 20 (hashPackageHashInputs pkghashinputs))
136141
]
137142
where
138-
PackageIdentifier name version _compid = pkgHashPkgId
143+
PackageIdentifier name version (Just compid) = pkgHashPkgId
139144

140145
-- Truncate a string, with a visual indication that it is truncated.
141146
truncateStr n s
@@ -167,7 +172,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
167172
hashedInstalledPackageIdVeryShort :: HasCallStack => PackageHashInputs -> InstalledPackageId
168173
hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
169174
mkComponentId $
170-
prettyShow (pkgHashCompilerId . pkgHashOtherConfig $ pkghashinputs)
175+
prettyShow compid
171176
++
172177
'_':intercalate
173178
"-"
@@ -176,7 +181,7 @@ hashedInstalledPackageIdVeryShort pkghashinputs@PackageHashInputs{pkgHashPkgId}
176181
, showHashValue (truncateHash 4 (hashPackageHashInputs pkghashinputs))
177182
]
178183
where
179-
PackageIdentifier name version _compid = pkgHashPkgId
184+
PackageIdentifier name version (Just compid) = pkgHashPkgId
180185

181186
-- | All the information that contributes to a package's hash, and thus its
182187
-- 'InstalledPackageId'.

‎cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -834,6 +834,8 @@ buildAndInstallUnpackedPackage
834834
++ unwords (map whyNotPerComponent $ NE.toList pkgWhyNotPerComponent)
835835
++ ", "
836836
++ dispcompiler (elabStage pkg)
837+
-- ++ ", "
838+
-- ++ show uid
837839
++ ")"
838840
-- Packages built per component
839841
ElabComponent comp ->
@@ -842,6 +844,8 @@ buildAndInstallUnpackedPackage
842844
++ maybe "custom" prettyShow (compComponentName comp)
843845
++ ", "
844846
++ dispcompiler (elabStage pkg)
847+
-- ++ ", "
848+
-- ++ show uid
845849
++ ")"
846850
dispcompiler :: Stage -> String
847851
dispcompiler Host = showCompilerId (toolchainCompiler (hostToolchain toolchains))

0 commit comments

Comments
 (0)