Switch unregister reason from Maybe Text to Text

The previous commit (fixing #2904) made the Maybe layer confusing and
error-prone. It was too easy to end up accidentally skipping an
unregister based on the two levels of Maybe wrapping. This simplifies
the codebase, without any change in behavior.

It would be even nicer to be able to prove statically that we always
generate a dirty reason.

src/Stack/Build/ConstructPlan.hs

@@ -221,7 +221,7 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackag
 -- | State to be maintained during the calculation of local packages
 -- to unregister.
 data UnregisterState = UnregisterState
-    { usToUnregister :: !(Map GhcPkgId (PackageIdentifier, Maybe Text))
+    { usToUnregister :: !(Map GhcPkgId (PackageIdentifier, Text))
     , usKeep :: ![DumpPackage () () ()]
     , usAnyAdded :: !Bool
     }
@@ -235,7 +235,7 @@ mkUnregisterLocal :: Map PackageName Task
                   -> [DumpPackage () () ()]
                   -- ^ Local package database dump
                   -> SourceMap
-                  -> Map GhcPkgId (PackageIdentifier, Maybe Text)
+                  -> Map GhcPkgId (PackageIdentifier, Text)
 mkUnregisterLocal tasks dirtyReason localDumpPkgs sourceMap =
     -- We'll take multiple passes through the local packages. This
     -- will allow us to detect that a package should be unregistered,
@@ -262,20 +262,14 @@ mkUnregisterLocal tasks dirtyReason localDumpPkgs sourceMap =
 
     go dp = do
         us <- get
-        -- Determine the reason for unregistering this package, if we
-        -- will in fact unregister it. We've (unfortunately got two
-        -- layers of Maybe wrapping here: a Nothing means "don't
-        -- unregister." A Just Nothing means "unregister, but we don't
-        -- know why".
-        let mmreason = go' (usToUnregister us) ident deps
-        case mmreason of
+        case go' (usToUnregister us) ident deps of
             -- Not unregistering, add it to the keep list
             Nothing -> put us { usKeep = dp : usKeep us }
             -- Unregistering, add it to the unregister Map and
             -- indicate that a package was in fact added to the
             -- unregister Map so we loop again.
-            Just mreason -> put us
-                { usToUnregister = Map.insert gid (ident, mreason) (usToUnregister us)
+            Just reason -> put us
+                { usToUnregister = Map.insert gid (ident, reason) (usToUnregister us)
                 , usAnyAdded = True
                 }
       where
@@ -287,13 +281,13 @@ mkUnregisterLocal tasks dirtyReason localDumpPkgs sourceMap =
       -- If we're planning on running a task on it, then it must be
       -- unregistered
       | Just _ <- Map.lookup name tasks
-          = Just $ Map.lookup name dirtyReason
+          = Just $ fromMaybe undefined $ Map.lookup name dirtyReason
       -- Check if we're no longer using the local version
       | Just (PSUpstream _ Snap _ _ _) <- Map.lookup name sourceMap
-          = Just $ Just "Switching to snapshot installed package"
+          = Just "Switching to snapshot installed package"
       -- Check if a dependency is going to be unregistered
       | (dep, _):_ <- mapMaybe (`Map.lookup` toUnregister) deps
-          = Just $ Just $ "Dependency being unregistered: " <> packageIdentifierText dep
+          = Just $ "Dependency being unregistered: " <> packageIdentifierText dep
       -- None of the above, keep it!
       | otherwise = Nothing
       where

src/Stack/Build/Execute.hs

@@ -140,11 +140,11 @@ printPlan plan = do
         [] -> $logInfo "No packages would be unregistered."
         xs -> do
             $logInfo "Would unregister locally:"
-            forM_ xs $ \(ident, mreason) -> $logInfo $ T.concat
+            forM_ xs $ \(ident, reason) -> $logInfo $ T.concat
                 [ T.pack $ packageIdentifierString ident
-                , case mreason of
-                    Nothing -> ""
-                    Just reason -> T.concat
+                , if T.null reason
+                    then ""
+                    else T.concat
                         [ " ("
                         , reason
                         , ")"
@@ -591,13 +591,13 @@ executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do
         [] -> return ()
         ids -> do
             localDB <- packageDatabaseLocal
-            forM_ ids $ \(id', (ident, mreason)) -> do
+            forM_ ids $ \(id', (ident, reason)) -> do
                 $logInfo $ T.concat
                     [ T.pack $ packageIdentifierString ident
                     , ": unregistering"
-                    , case mreason of
-                        Nothing -> ""
-                        Just reason -> T.concat
+                    , if T.null reason
+                        then ""
+                        else T.concat
                             [ " ("
                             , reason
                             , ")"

src/Stack/Types/Build.hs

@@ -447,7 +447,7 @@ data Plan = Plan
     { planTasks :: !(Map PackageName Task)
     , planFinals :: !(Map PackageName Task)
     -- ^ Final actions to be taken (test, benchmark, etc)
-    , planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Maybe Text))
+    , planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Text))
     -- ^ Text is reason we're unregistering, for display only
     , planInstallExes :: !(Map Text InstallLocation)
     -- ^ Executables that should be installed after successful building