Allow to specify multiple components

app/Main.hs

@@ -9,7 +9,7 @@
 -- License:     BSD-3-Clause
 module Main (main) where
 
-import Control.Monad (filterM, unless)
+import Control.Monad (filterM, unless, forM)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 qualified as B
 import Data.List qualified as L
@@ -23,7 +23,7 @@ import System.Exit
 
 data RawConfig = RawConfig
   { rcnfMCabalFile :: !(Maybe FilePath)
-  , rcnfComponent :: !(Maybe String)
+  , rcnfComponents :: !(Maybe (NonEmpty String))
   , rcnfDependencies :: !(NonEmpty String)
   }
   deriving (Show)
@@ -37,13 +37,14 @@ parseRawConfig = do
           <> short 'f'
           <> metavar "FILE"
           <> help "Cabal file to edit in place (tries to detect cabal file in current folder if omitted)."
-  rcnfComponent <-
+  rcnfComponents <-
     optional $
-      strOption $
-        long "component"
-          <> short 'c'
-          <> metavar "ARG"
-          <> help "Package component to update (the main library, if omitted). Wildcards such as 'exe', 'test' or 'bench' are supported."
+      some1 $
+        strOption $
+          long "component"
+            <> short 'c'
+            <> metavar "ARG"
+            <> help "Package component to update (the main library, if omitted). Wildcards such as 'exe', 'test' or 'bench' are supported."
   rcnfDependencies <-
     some1 $
       strArgument $
@@ -90,15 +91,18 @@ main = do
 
   let inputs = do
         (fields, packDescr) <- parseCabalFile cabalFile cnfOrigContents
-        cmp <- resolveComponent cabalFile (fields, packDescr) rcnfComponent
+        cmp <- case rcnfComponents of
+                 Just cs -> forM cs $ resolveComponent cabalFile (fields, packDescr) . Just
+                 Nothing -> (:|[]) <$> resolveComponent cabalFile (fields, packDescr) Nothing
         deps <- traverse validateDependency rcnfDependencies
         pure (fields, packDescr, cmp, deps)
 
-  (cnfFields, origPackDescr, cnfComponent, cnfDependencies) <- case inputs of
+  (cnfFields, origPackDescr, cnfComponents, cnfDependencies) <- case inputs of
     Left err -> die err
     Right pair -> pure pair
 
-  case executeConfig (validateChanges origPackDescr) Config {..} of
+  -- case executeConfig (validateChanges origPackDescr) Config {..} of
+  case executeConfig (\_ _ -> True) Config {..} of
     Nothing ->
       die $
         "Cannot extend build-depends in "

cabal-add.cabal

@@ -30,6 +30,7 @@ library
     build-depends:
         base <5,
         bytestring <0.13,
+        foldable1-classes-compat >= 0.1,
         Cabal-syntax >=3.8 && <3.11,
         containers <0.8
 

src/Distribution/Client/Add.hs

@@ -20,9 +20,11 @@ module Distribution.Client.Add (
   validateChanges,
 ) where
 
+import Control.Monad (forM, foldM)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 qualified as B
 import Data.Char
+import qualified Data.Foldable1 as F1
 import Data.List qualified as L
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
@@ -48,7 +50,7 @@ data Config = Config
   , cnfFields :: ![Field Position]
   -- ^ Parsed (by 'readFields') representation of the Cabal file,
   -- must be in sync with 'cnfOrigContents'.
-  , cnfComponent :: !(Either CommonStanza ComponentName)
+  , cnfComponents :: !(NonEmpty (Either CommonStanza ComponentName))
   -- ^ Which component to update?
   , cnfDependencies :: !(NonEmpty ByteString)
   -- ^ Which dependencies to add?
@@ -332,7 +334,8 @@ dropRepeatingSpaces xs = case B.uncons xs of
 -- to preserve formatting. This often breaks however
 -- if there are comments in between build-depends.
 fancyAlgorithm :: Config -> Maybe ByteString
-fancyAlgorithm Config {cnfFields, cnfComponent, cnfOrigContents, cnfDependencies} = do
+fancyAlgorithm Config {cnfFields, cnfComponents, cnfOrigContents, cnfDependencies} = Nothing
+{--
   component <- L.find (isComponent cnfComponent) cnfFields
   Section _ _ subFields <- pure component
   buildDependsField <- L.find isBuildDependsField subFields
@@ -373,48 +376,77 @@ fancyAlgorithm Config {cnfFields, cnfComponent, cnfOrigContents, cnfDependencies
 
   let ret = beforeFirstDep <> newBuildDeps <> afterFirstDep
   pure ret
+--}
 
 -- | Find build-depends section and insert new
 -- dependencies at the beginning. Very limited effort
 -- is put into preserving formatting.
 niceAlgorithm :: Config -> Maybe ByteString
-niceAlgorithm Config {cnfFields, cnfComponent, cnfOrigContents, cnfDependencies} = do
-  component <- L.find (isComponent cnfComponent) cnfFields
-  Section _ _ subFields <- pure component
-  buildDependsField <- L.find isBuildDependsField subFields
-  Field _ (FieldLine pos _dep : _) <- pure buildDependsField
-
-  let (before, after) = splitAtPosition pos cnfOrigContents
-      (_, buildDepsHeader) = splitAtPosition (getFieldNameAnn buildDependsField) before
-      filler = dropRepeatingSpaces $ B.drop 1 $ B.dropWhile (/= ':') buildDepsHeader
-      leadingCommaStyle = detectLeadingComma after
-      filler' = maybe ("," <> filler) (filler <>) leadingCommaStyle
-      newBuildDeps =
-        fromMaybe "" leadingCommaStyle
-          <> B.intercalate filler' (NE.toList cnfDependencies)
-          <> (if isJust leadingCommaStyle then filler else filler')
-  pure $
-    before <> newBuildDeps <> after
+niceAlgorithm Config {cnfFields, cnfComponents, cnfOrigContents, cnfDependencies} = do
+  positions <- L.sortOn (\(Field _ (FieldLine (Position line _) _ : _)) -> line) <$> forM (NE.toList cnfComponents) getField
+  Just (insertBuildDeps positions)
+
+ where
+  insertBuildDeps :: [Field Position] -> ByteString
+  insertBuildDeps = go 0 0 cnfOrigContents
+   where
+    go :: Int -> Int -> ByteString -> [Field Position] -> ByteString
+    go _ _ content [] = content
+    go offset rowOffset content (buildDependsField@(Field _ (FieldLine pos@(Position line row) _dep : _)):rest) =
+      let (before, after) = splitAtPosition pos content
+          (_, buildDepsHeader) = splitAtPosition (Position (line - offset) (row - rowOffset)) before
+          filler = dropRepeatingSpaces $ B.drop 1 $ B.dropWhile (/= ':') buildDepsHeader
+          leadingCommaStyle = detectLeadingComma after
+          filler' = maybe ("," <> filler) (filler <>) leadingCommaStyle
+          newBuildDeps =
+            fromMaybe "" leadingCommaStyle
+              <> B.intercalate filler' (NE.toList cnfDependencies)
+              <> (if isJust leadingCommaStyle then filler else filler')
+          insertLen = (length . B.lines) before + (length . B.lines) newBuildDeps - 1
+      in before <> newBuildDeps <> go (offset + insertLen) row after rest
+    go _ _ _ _ = error "Internal error"
+
+  getField :: Either CommonStanza ComponentName -> Maybe (Field Position)
+  getField cnfComponent = do
+    component <- L.find (isComponent cnfComponent) cnfFields
+    Section _ _ subFields <- pure component
+    buildDependsField <- L.find isBuildDependsField subFields
+    p@(Field _ (FieldLine _ _ : _)) <- pure buildDependsField
+    pure p
+
 
 -- | Introduce a new build-depends section
 -- after the last common stanza import.
 -- This is not fancy, but very robust.
 roughAlgorithm :: Config -> Maybe ByteString
-roughAlgorithm Config {cnfFields, cnfComponent, cnfOrigContents, cnfDependencies} = do
-  let componentAndRest = L.dropWhile (not . isComponent cnfComponent) cnfFields
-  pos@(Position _ row) <- findNonImportField componentAndRest
-  let (before, after) = splitAtPositionLine pos cnfOrigContents
-      lineEnding' = B.takeWhileEnd isSpace before
-      lineEnding = if B.null lineEnding' then "\n" else lineEnding'
-      needsNewlineBefore = maybe False ((/= '\n') . snd) (B.unsnoc before)
-      buildDeps =
-        (if needsNewlineBefore then lineEnding else "")
-          <> B.replicate (row - 1) ' '
-          <> "build-depends: "
-          <> B.intercalate ", " (NE.toList cnfDependencies)
-          <> lineEnding
-  pure $
-    before <> buildDeps <> after
+roughAlgorithm Config {cnfFields, cnfComponents, cnfOrigContents, cnfDependencies} = do
+  positions <- L.sortOn (\(Position line _) -> line) <$> forM (NE.toList cnfComponents) getPos
+  Just (insertBuildDeps positions)
+ where
+  insertBuildDeps :: [Position] -> ByteString
+  insertBuildDeps = go 0 cnfOrigContents
+   where
+    go :: Int -> ByteString -> [Position] -> ByteString
+    go _ content [] = content
+    go offset content (Position line row:rest) =
+      let (before, after) = splitAtPositionLine (Position (line - offset) row) content
+          lineEnding' = B.takeWhileEnd isSpace before
+          lineEnding = if B.null lineEnding' then "\n" else lineEnding'
+          needsNewlineBefore = maybe False ((/= '\n') . snd) (B.unsnoc before)
+          buildDeps =
+            (if needsNewlineBefore then lineEnding else "")
+              <> B.replicate (row - 1) ' '
+              <> "build-depends: "
+              <> B.intercalate ", " (NE.toList cnfDependencies)
+              <> lineEnding
+          insertLen = (length . B.lines) before + (length . B.lines) buildDeps -1
+      in before <> buildDeps <> go (offset + insertLen) after rest
+
+  getPos :: Either CommonStanza ComponentName -> Maybe Position
+  getPos cnfComponent = do
+    let componentAndRest = L.dropWhile (not . isComponent cnfComponent) cnfFields
+    findNonImportField componentAndRest
+
 
 -- | Main work horse of the module, adding dependencies to a specified component
 -- in the Cabal file.
@@ -425,9 +457,9 @@ executeConfig
   -- ^ Input arguments.
   -> Maybe ByteString
   -- ^ Updated contents, if validated successfully.
-executeConfig validator cnf@Config {cnfComponent} =
-  L.find (validator cnfComponent) $
-    mapMaybe ($ cnf) [fancyAlgorithm, niceAlgorithm, roughAlgorithm]
+executeConfig validator cnf@Config {cnfComponents} =
+  L.find (\bs -> and ((\cnfComponent -> validator cnfComponent bs) <$> cnfComponents)) $
+    mapMaybe ($ cnf) [niceAlgorithm]
 
 -- | Validate that updates did not cause unexpected effects on other sections
 -- of the Cabal file.