From 56f9b3570680efa58f497158fe26ef90e1bf4081 Mon Sep 17 00:00:00 2001
From: Mike Pilgrem <mpilgrem@users.noreply.github.com>
Date: Mon, 23 Oct 2023 22:37:40 +0100
Subject: [PATCH] Rationalise `ParentMap` type synonym, given its actual use

---
 src/Stack/Build/ConstructPlan.hs   | 9 ++++-----
 src/Stack/Types/Build/Exception.hs | 4 ++--
 src/Stack/Types/ParentMap.hs       | 2 +-
 3 files changed, 7 insertions(+), 8 deletions(-)

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
index df942caea6..7473727e83 100644
--- a/src/Stack/Build/ConstructPlan.hs
+++ b/src/Stack/Build/ConstructPlan.hs
@@ -907,7 +907,7 @@ addPackageDeps package = do
             Just (lappVer, cabalHash)
     case eres of
       Left e -> do
-        addParent depname range Nothing
+        addParent depname range
         let bd = case e of
               UnknownPackage name -> assert (name == depname) NotInBuildPlan
               DependencyCycleDetected names -> BDDependencyCycleDetected names
@@ -921,7 +921,7 @@ addPackageDeps package = do
       Right adr | depType == AsLibrary && not (adrHasLibrary adr) ->
         pure $ Left (depname, (range, Nothing, HasNoLibrary))
       Right adr -> do
-        addParent depname range Nothing
+        addParent depname range
         inRange <- if adrVersion adr `withinRange` range
           then pure True
           else do
@@ -1038,10 +1038,9 @@ addPackageDeps package = do
   adrVersion (ADRFound _ installed) = installedVersion installed
   -- Update the parents map, for later use in plan construction errors
   -- - see 'getShortestDepsPath'.
-  addParent depname range mversion =
-    tell mempty { wParents = MonoidMap $ Map.singleton depname val }
+  addParent depname range = tell mempty { wParents = MonoidMap parentMap }
    where
-    val = (First mversion, [(packageIdentifier package, range)])
+    parentMap = Map.singleton depname [(packageIdentifier package, range)]
 
   adrHasLibrary :: AddDepRes -> Bool
   adrHasLibrary (ADRToInstall task) = taskHasLibrary task
diff --git a/src/Stack/Types/Build/Exception.hs b/src/Stack/Types/Build/Exception.hs
index 2d589f0175..fdb97ebefc 100644
--- a/src/Stack/Types/Build/Exception.hs
+++ b/src/Stack/Types/Build/Exception.hs
@@ -837,7 +837,7 @@ getShortestDepsPath (MonoidMap parentsMap) wanted' name =
     then Just []
     else case M.lookup name parentsMap of
       Nothing -> Nothing
-      Just (_, parents) -> Just $ findShortest 256 paths0
+      Just parents -> Just $ findShortest 256 paths0
        where
         paths0 = M.fromList $
           map (\(ident, _) -> (pkgName ident, startDepsPath ident)) parents
@@ -869,7 +869,7 @@ getShortestDepsPath (MonoidMap parentsMap) wanted' name =
   extendPath (n, dp) =
     case M.lookup n parentsMap of
       Nothing -> []
-      Just (_, parents) ->
+      Just parents ->
         map (\(pkgId, _) -> (pkgName pkgId, extendDepsPath pkgId dp)) parents
 
 startDepsPath :: PackageIdentifier -> DepsPath
diff --git a/src/Stack/Types/ParentMap.hs b/src/Stack/Types/ParentMap.hs
index 5634badd15..b3933d81e2 100644
--- a/src/Stack/Types/ParentMap.hs
+++ b/src/Stack/Types/ParentMap.hs
@@ -9,4 +9,4 @@ import           Stack.Prelude
 import           Stack.Types.Version ( VersionRange )
 
 type ParentMap =
-  MonoidMap PackageName (First Version, [(PackageIdentifier, VersionRange)])
+  MonoidMap PackageName [(PackageIdentifier, VersionRange)]