From 39db107f6afb4169e1294b548690ea591ae10fbe Mon Sep 17 00:00:00 2001
From: Rebecca Turner <rbt@sent.as>
Date: Fri, 27 Sep 2024 16:43:30 -0700
Subject: [PATCH] Move `addFields` to `ParseUtils`, add `aliasField` helper

`addFields` should be in `ParseUtils` with the rest of the field
helpers.
---
 .../src/Distribution/Client/ParseUtils.hs     | 32 +++++++++++++++++++
 .../Client/ProjectConfig/Legacy.hs            |  6 ----
 2 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/cabal-install/src/Distribution/Client/ParseUtils.hs b/cabal-install/src/Distribution/Client/ParseUtils.hs
index 44cdc4ccc22..18062b7428f 100644
--- a/cabal-install/src/Distribution/Client/ParseUtils.hs
+++ b/cabal-install/src/Distribution/Client/ParseUtils.hs
@@ -17,6 +17,8 @@ module Distribution.Client.ParseUtils
     FieldDescr (..)
   , liftField
   , liftFields
+  , addFields
+  , aliasField
   , filterFields
   , mapFieldNames
   , commandOptionToField
@@ -103,9 +105,15 @@ liftFields get set = map (liftField get set)
 
 -- | Given a collection of field descriptions, keep only a given list of them,
 -- identified by name.
+--
+-- TODO: This makes it easy to footgun by providing a non-existent field name.
 filterFields :: [String] -> [FieldDescr a] -> [FieldDescr a]
 filterFields includeFields = filter ((`elem` includeFields) . fieldName)
 
+-- | Given a collection of field descriptions, get a field with a given name.
+getField :: String -> [FieldDescr a] -> Maybe (FieldDescr a)
+getField name = find ((== name) . fieldName)
+
 -- | Apply a name mangling function to the field names of all the field
 -- descriptions. The typical use case is to apply some prefix.
 mapFieldNames :: (String -> String) -> [FieldDescr a] -> [FieldDescr a]
@@ -120,6 +128,30 @@ commandOptionToField = viewAsFieldDescr
 commandOptionsToFields :: [OptionField a] -> [FieldDescr a]
 commandOptionsToFields = map viewAsFieldDescr
 
+-- | Add fields to a field list.
+addFields
+  :: [FieldDescr a]
+  -> ([FieldDescr a] -> [FieldDescr a])
+addFields = (++)
+
+-- | Add a new field which is identical to an existing field but with a
+-- different name.
+aliasField
+  :: String
+  -- ^ The existing field name.
+  -> String
+  -- ^ The new field name.
+  -> [FieldDescr a]
+  -> [FieldDescr a]
+aliasField oldName newName fields =
+  let fieldToRename = getField oldName fields
+   in case fieldToRename of
+        -- TODO: Should this throw?
+        Nothing -> fields
+        Just fieldToRename' ->
+          let newField = fieldToRename'{fieldName = newName}
+           in newField : fields
+
 ------------------------------------------
 -- SectionDescr definition and utilities
 --
diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
index 7ed13df1232..ab3af5ee2fd 100644
--- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
+++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -2073,9 +2073,3 @@ showTokenQ "" = Disp.empty
 showTokenQ x@('-' : '-' : _) = Disp.text (show x)
 showTokenQ x@('.' : []) = Disp.text (show x)
 showTokenQ x = showToken x
-
--- Handy util
-addFields
-  :: [FieldDescr a]
-  -> ([FieldDescr a] -> [FieldDescr a])
-addFields = (++)