Move addFields to ParseUtils

cabal-install/src/Distribution/Client/Config.hs

@@ -160,6 +160,7 @@ import qualified Distribution.Deprecated.ParseUtils as ParseUtils
 import Distribution.Parsec (ParsecParser, parsecFilePath, parsecOptCommaList, parsecToken)
 import Distribution.Simple.Command
   ( CommandUI (commandOptions)
+  , OptionField
   , ShowOrParseArgs (..)
   , commandDefaultFlags
   )
@@ -1314,6 +1315,19 @@ configFieldDescriptions src =
             ParseArgs
        ]
   where
+    toSavedConfig
+      :: (FieldDescr a -> FieldDescr SavedConfig)
+      -- Lifting function.
+      -> [OptionField a]
+      -- Option fields.
+      -> [String]
+      -- Fields to exclude, by name.
+      -> [FieldDescr a]
+      -- Field replacements.
+      --
+      -- If an option is found with the same name as one of these replacement
+      -- fields, the replacement field is used instead of the option.
+      -> [FieldDescr SavedConfig]
     toSavedConfig lift options exclusions replacements =
       [ lift (fromMaybe field replacement)
       | opt <- options

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
 --

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 = (++)