Skip to content

Commit 83cff8c

Browse files
mgsloanmgsloan
committed
Revert "Always assume local GHCJS packages are dirty commercialhaskell#2341"
This reverts commit a7fc244.
1 parent d28255e commit 83cff8c

1 file changed

Lines changed: 34 additions & 41 deletions

File tree

‎src/Stack/Build/ConstructPlan.hs‎

Lines changed: 34 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,6 @@ import Stack.PackageDump
5555
import Stack.PackageIndex
5656
import Stack.PrettyPrint
5757
import Stack.Types.Build
58-
import Stack.Types.Compiler
5958
import Stack.Types.Config
6059
import Stack.Types.FlagName
6160
import Stack.Types.GhcPkgId
@@ -71,13 +70,11 @@ data PackageInfo
7170
| PIBoth PackageSource Installed
7271
deriving (Show)
7372

74-
combineSourceInstalled :: WhichCompiler
75-
-> PackageSource
73+
combineSourceInstalled :: PackageSource
7674
-> (InstallLocation, Installed)
7775
-> PackageInfo
78-
combineSourceInstalled wc ps (location, installed) =
79-
-- NOTE: special case for GHCJS - we expect some packages to differ
80-
(if wc /= Ghcjs then assert (piiVersion ps == installedVersion installed) else id) $
76+
combineSourceInstalled ps (location, installed) =
77+
assert (piiVersion ps == installedVersion installed) $
8178
assert (piiLocation ps == location) $
8279
case location of
8380
-- Always trust something in the snapshot
@@ -86,9 +83,9 @@ combineSourceInstalled wc ps (location, installed) =
8683

8784
type CombinedMap = Map PackageName PackageInfo
8885

89-
combineMap :: WhichCompiler -> SourceMap -> InstalledMap -> CombinedMap
90-
combineMap wc = Map.mergeWithKey
91-
(\_ s i -> Just $ combineSourceInstalled wc s i)
86+
combineMap :: SourceMap -> InstalledMap -> CombinedMap
87+
combineMap = Map.mergeWithKey
88+
(\_ s i -> Just $ combineSourceInstalled s i)
9289
(fmap PIOnlySource)
9390
(fmap (uncurry PIOnlyInstalled))
9491

@@ -168,9 +165,8 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackag
168165
mapM_ onWanted $ filter lpWanted locals
169166
mapM_ (addDep False) $ Set.toList extraToBuild0
170167
lf <- askLoggerIO
171-
wc <- getWhichCompiler
172168
((), m, W efinals installExes dirtyReason deps warnings parents) <-
173-
liftIO $ runRWST inner (ctx wc econfig getVersions0 lf) M.empty
169+
liftIO $ runRWST inner (ctx econfig getVersions0 lf) M.empty
174170
mapM_ $logWarn (warnings [])
175171
let toEither (_, Left e) = Left e
176172
toEither (k, Right v) = Right (k, v)
@@ -201,11 +197,11 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackag
201197
$prettyError $ pprintExceptions errs (bcStackYaml (getBuildConfig econfig)) parents (wantedLocalPackages locals)
202198
throwM $ ConstructPlanFailed "Plan construction failed."
203199
where
204-
ctx wc econfig getVersions0 lf = Ctx
200+
ctx econfig getVersions0 lf = Ctx
205201
{ mbp = mbp0
206202
, baseConfigOpts = baseConfigOpts0
207203
, loadPackage = loadPackage0
208-
, combinedMap = combineMap wc sourceMap installedMap
204+
, combinedMap = combineMap sourceMap installedMap
209205
, toolToPackages = \(Cabal.Dependency name _) ->
210206
maybe Map.empty (Map.fromSet (const Cabal.anyVersion)) $
211207
Map.lookup (T.pack . packageNameString . fromCabalPackageName $ name) toolMap
@@ -552,41 +548,38 @@ checkDirtiness :: PackageSource
552548
-> Set PackageName
553549
-> M Bool
554550
checkDirtiness ps installed package present wanted = do
555-
wc <- getWhichCompiler
556-
mreason <- case (ps, wc) of
557-
(PSLocal _, Ghcjs) -> return $ Just "local ghcjs package always dirty"
558-
_ -> do
559-
ctx <- ask
560-
moldOpts <- flip runLoggingT (logFunc ctx) $ tryGetFlagCache installed
561-
let configOpts = configureOpts
562-
(getEnvConfig ctx)
563-
(baseConfigOpts ctx)
564-
present
565-
(psLocal ps)
566-
(piiLocation ps) -- should be Local always
567-
package
568-
buildOpts = bcoBuildOpts (baseConfigOpts ctx)
569-
wantConfigCache = ConfigCache
570-
{ configCacheOpts = configOpts
571-
, configCacheDeps = Set.fromList $ Map.elems present
572-
, configCacheComponents =
573-
case ps of
574-
PSLocal lp -> Set.map renderComponent $ lpComponents lp
575-
PSUpstream{} -> Set.empty
576-
, configCacheHaddock =
577-
shouldHaddockPackage buildOpts wanted (packageName package) ||
578-
-- Disabling haddocks when old config had haddocks doesn't make dirty.
579-
maybe False configCacheHaddock moldOpts
580-
}
581-
let config = getConfig ctx
582-
return $ case moldOpts of
551+
ctx <- ask
552+
moldOpts <- flip runLoggingT (logFunc ctx) $ tryGetFlagCache installed
553+
let configOpts = configureOpts
554+
(getEnvConfig ctx)
555+
(baseConfigOpts ctx)
556+
present
557+
(psLocal ps)
558+
(piiLocation ps) -- should be Local always
559+
package
560+
buildOpts = bcoBuildOpts (baseConfigOpts ctx)
561+
wantConfigCache = ConfigCache
562+
{ configCacheOpts = configOpts
563+
, configCacheDeps = Set.fromList $ Map.elems present
564+
, configCacheComponents =
565+
case ps of
566+
PSLocal lp -> Set.map renderComponent $ lpComponents lp
567+
PSUpstream{} -> Set.empty
568+
, configCacheHaddock =
569+
shouldHaddockPackage buildOpts wanted (packageName package) ||
570+
-- Disabling haddocks when old config had haddocks doesn't make dirty.
571+
maybe False configCacheHaddock moldOpts
572+
}
573+
let mreason =
574+
case moldOpts of
583575
Nothing -> Just "old configure information not found"
584576
Just oldOpts
585577
| Just reason <- describeConfigDiff config oldOpts wantConfigCache -> Just reason
586578
| True <- psForceDirty ps -> Just "--force-dirty specified"
587579
| Just files <- psDirty ps -> Just $ "local file changes: " <>
588580
addEllipsis (T.pack $ unwords $ Set.toList files)
589581
| otherwise -> Nothing
582+
config = getConfig ctx
590583
case mreason of
591584
Nothing -> return False
592585
Just reason -> do

0 commit comments

Comments
 (0)