cabal-add (empty) → 0.1
raw patch · 7 files changed
+2355/−0 lines, 7 filesdep +Cabaldep +Cabal-syntaxdep +Diff
Dependencies added: Cabal, Cabal-syntax, Diff, base, bytestring, cabal-add, cabal-install-parsers, containers, directory, filepath, mtl, optparse-applicative, process, string-qq, tasty, temporary
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- README.md +45/−0
- app/Main.hs +212/−0
- cabal-add.cabal +88/−0
- src/Distribution/Client/Add.hs +571/−0
- tests/Main.hs +1406/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## 0.1++* Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2023, Bodigrim++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Bodigrim nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,45 @@+# cabal-add [](https://hackage.haskell.org/package/cabal-add) [](http://stackage.org/lts/package/cabal-add) [](http://stackage.org/nightly/package/cabal-add)++Extend Cabal `build-depends` from the command line.++`cabal-add` does not have limitations of+[`cabal-edit`](https://hackage.haskell.org/package/cabal-edit):+it works on any sectioned Cabal file,+supports stanzas and conditional blocks,+and preserves original formatting.++Install the executable with++```+cabal install cabal-add+```++To add a dependency on `foo`, switch to a folder with your project and execute++```+cabal-add foo+```++If you are using Cabal 3.12+ which supports+[external commands](https://cabal.readthedocs.io/en/3.12/external-commands.html),+you can omit the dash:++```+cabal add foo+```++Command-line arguments:++* `--project-file FILE`++ Set the path of the cabal.project file. Detect `cabal.project` or `*.cabal`+ in the current folder, if omitted.++* `ARGS`++ Optional [target](https://cabal.readthedocs.io/en/latest/cabal-commands.html#target-forms)+ (wildcards such as `exe`, `test` or `bench` are supported) to update, followed+ by a non-empty list of package(s) to add to+ `build-depends` section. Version bounds can be+ provided as well, use quotes to escape comparisons+ from your shell. E. g., `'foo < 0.2'`.
+ app/Main.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Copyright: (c) 2023 Bodigrim+-- License: BSD-3-Clause+module Main (main) where++import Cabal.Project (parseProject, prjPackages, resolveProject)+import Control.Exception (throwIO)+import Control.Monad (filterM)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as B+import Data.Either (partitionEithers)+import Data.List qualified as L+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (catMaybes)+import Distribution.CabalSpecVersion (CabalSpecVersion)+import Distribution.Client.Add+import Distribution.Fields (Field)+import Distribution.PackageDescription (+ ComponentName,+ GenericPackageDescription,+ packageDescription,+ specVersion,+ )+import Distribution.PackageDescription.Quirks (patchQuirks)+import Distribution.Parsec (Position)+import Options.Applicative (+ Parser,+ execParser,+ fullDesc,+ help,+ helper,+ info,+ long,+ metavar,+ optional,+ progDesc,+ strArgument,+ strOption,+ )+import Options.Applicative.NonEmpty (some1)+import System.Directory (doesFileExist, listDirectory)+import System.Environment (getArgs, withArgs)+import System.Exit (die)+import System.FilePath (takeDirectory, (</>))++data RawConfig = RawConfig+ { rcnfMProjectFile :: !(Maybe FilePath)+ , rcnfArgs :: !(NonEmpty String)+ }+ deriving (Show)++parseRawConfig :: Parser RawConfig+parseRawConfig = do+ rcnfMProjectFile <-+ optional $+ strOption $+ long "project-file"+ <> metavar "FILE"+ <> help "Set the path of the cabal.project file. Detect cabal.project or *.cabal in the current folder, if omitted."+ rcnfArgs <-+ some1 $+ strArgument $+ metavar "ARGS"+ <> help "Optional package component (wildcards such as 'exe', 'test' or 'bench' are supported) to update, followed by a non-empty list of package(s) to add to 'build-depends' section. Version bounds can be provided as well, use quotes to escape comparisons from your shell. E. g., 'foo < 0.2'."+ pure RawConfig {..}++resolveCabalProjectInCurrentFolder :: IO (Maybe FilePath)+resolveCabalProjectInCurrentFolder = do+ let fn = "cabal.project"+ exists <- doesFileExist fn+ pure $ if exists then Just fn else Nothing++resolveCabalFileInCurrentFolder :: IO (Either String FilePath)+resolveCabalFileInCurrentFolder = do+ files <- listDirectory "."++ -- filter in two steps to reduce IO+ let cabalFiles' = filter (".cabal" `L.isSuffixOf`) files+ -- make sure we don't catch directories+ cabalFiles <- filterM doesFileExist cabalFiles'++ pure $ case cabalFiles of+ [] ->+ Left "Found no cabal files in current folder. Giving up."+ [fn] ->+ Right fn+ _ : _ : _ ->+ Left "Found multiple cabal files in current folder. Giving up."++extractCabalFilesFromProject :: FilePath -> IO [FilePath]+extractCabalFilesFromProject projectFn = do+ project <- B.readFile projectFn+ parsed <- case parseProject projectFn project of+ Left exc -> throwIO exc+ Right p -> pure p+ resolved <- resolveProject projectFn parsed+ case resolved of+ Left exc -> throwIO exc+ Right prj -> pure $ map (takeDirectory projectFn </>) $ prjPackages prj++resolveCabalFiles :: Maybe FilePath -> IO [FilePath]+resolveCabalFiles = \case+ Nothing -> do+ projectFn <- resolveCabalProjectInCurrentFolder+ case projectFn of+ Nothing -> do+ cabalFn <- resolveCabalFileInCurrentFolder+ case cabalFn of+ Left e -> die e+ Right fn -> pure [fn]+ Just fn -> extractCabalFilesFromProject fn+ Just fn -> extractCabalFilesFromProject fn++readCabalFile :: FilePath -> IO (Maybe ByteString)+readCabalFile fileName = do+ cabalFileExists <- doesFileExist fileName+ if cabalFileExists+ then Just . snd . patchQuirks <$> B.readFile fileName+ else pure Nothing++stripAdd :: [String] -> [String]+stripAdd ("add" : xs) = xs+stripAdd xs = xs++type Input =+ ( FilePath+ , ByteString+ , [Field Position]+ , GenericPackageDescription+ , Either+ CommonStanza+ ComponentName+ , NonEmpty ByteString+ )++mkInputs+ :: Bool+ -> FilePath+ -> ByteString+ -> NonEmpty String+ -> Either String Input+mkInputs isCmpRequired cabalFile origContents args = do+ (fields, packDescr) <- parseCabalFile cabalFile origContents+ let specVer :: CabalSpecVersion+ specVer = specVersion $ packageDescription packDescr+ mkCmp :: Maybe String -> Either String (Either CommonStanza ComponentName)+ mkCmp = resolveComponent cabalFile (fields, packDescr)+ mkDeps :: NonEmpty String -> Either String (NonEmpty ByteString)+ mkDeps = traverse (validateDependency specVer)+ (cmp, deps) <- case args of+ x :| (y : ys)+ | Right c <- mkCmp (Just x) ->+ (c,) <$> mkDeps (y :| ys)+ _ ->+ if isCmpRequired+ then Left "Component is required"+ else (,) <$> mkCmp Nothing <*> mkDeps args+ pure (cabalFile, origContents, fields, packDescr, cmp, deps)++disambiguateInputs+ :: Maybe FilePath+ -> [FilePath]+ -> [Either a Input]+ -> Either String Input+disambiguateInputs mProjectFile cabalFiles inputs = case partitionEithers inputs of+ ([], []) -> Left $ case mProjectFile of+ Nothing -> "No Cabal files or projects are found in the current folder, please specify --project-file."+ Just projFn -> "No Cabal files are found in " ++ projFn+ (_errs, []) ->+ Left $+ "No matching targets found amongst: "+ ++ L.intercalate ", " cabalFiles+ (_, [inp]) -> pure inp+ (_, _inps) ->+ Left+ "Target component is ambiguous, please specify it as package:type:component. See https://cabal.readthedocs.io/en/latest/cabal-commands.html#target-forms for reference"++main :: IO ()+main = do+ rawArgs <- getArgs+ RawConfig {..} <-+ withArgs (stripAdd rawArgs) $+ execParser $+ info+ (helper <*> parseRawConfig)+ (fullDesc <> progDesc "Extend build-depends from the command line")++ cabalFiles <- resolveCabalFiles rcnfMProjectFile+ cabalFilesAndContent <-+ catMaybes+ <$> traverse (\fn -> fmap (fn,) <$> readCabalFile fn) cabalFiles+ let getInput isCmpRequired =+ disambiguateInputs rcnfMProjectFile (fmap fst cabalFilesAndContent) $+ map (\(fn, cnt) -> mkInputs isCmpRequired fn cnt rcnfArgs) cabalFilesAndContent++ input <- either (const $ either die pure $ getInput True) pure (getInput False)++ let (cabalFile, cnfOrigContents, cnfFields, origPackDescr, cnfComponent, cnfDependencies) = input++ case executeConfig (validateChanges origPackDescr) (Config {..}) of+ Nothing ->+ die $+ "Cannot extend build-depends in "+ ++ cabalFile+ ++ ", please report as a bug at https://github.com/Bodigrim/cabal-add/issues"+ Just r -> B.writeFile cabalFile r
+ cabal-add.cabal view
@@ -0,0 +1,88 @@+cabal-version: 3.0+name: cabal-add+version: 0.1+license: BSD-3-Clause+license-file: LICENSE+maintainer: andrew.lelechenko@gmail.com+author: Bodigrim+tested-with:+ ghc ==9.10.1 ghc ==9.8.2 ghc ==9.6.6 ghc ==9.4.8 ghc ==9.2.8++synopsis: Extend Cabal build-depends from the command line+description:+ Extend Cabal @build-depends@ from the command line.+ It works on any sectioned Cabal file,+ supports stanzas and conditional blocks,+ and preserves original formatting.++category: Development+build-type: Simple+extra-doc-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/Bodigrim/cabal-add.git++flag cabal-syntax+ default: False++library+ exposed-modules: Distribution.Client.Add+ hs-source-dirs: src+ default-language: GHC2021+ ghc-options: -Wall+ build-depends:+ base <5,+ bytestring <0.13,+ Cabal >=3.6 && <3.13,+ containers <0.8,+ mtl <2.4++ if flag(cabal-syntax)+ build-depends:+ Cabal-syntax >=3.8 && <3.13,+ Cabal >=3.8++ else+ build-depends:+ Cabal-syntax <3.7,+ Cabal <3.7++executable cabal-add+ main-is: Main.hs+ hs-source-dirs: app+ default-language: GHC2021+ ghc-options: -Wall+ build-depends:+ base <5,+ bytestring <0.13,+ cabal-add,+ cabal-install-parsers >=0.4.1 && <0.7,+ directory <1.4,+ filepath <1.6,+ optparse-applicative >=0.16 && <0.19,+ process <1.7++ if flag(cabal-syntax)+ build-depends: Cabal-syntax++ else+ build-depends: Cabal++test-suite cabal-add-tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-tool-depends: cabal-add:cabal-add+ hs-source-dirs: tests+ default-language: GHC2021+ ghc-options: -Wall+ build-depends:+ base <5,+ Diff >=0.4,+ directory,+ process,+ string-qq,+ tasty,+ temporary
+ src/Distribution/Client/Add.hs view
@@ -0,0 +1,571 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Copyright: (c) 2023 Bodigrim+-- License: BSD-3-Clause+--+-- Building blocks of @cabal-add@ executable.+module Distribution.Client.Add (+ parseCabalFile,+ resolveComponent,+ CommonStanza (..),+ validateDependency,+ Config (..),+ executeConfig,+ validateChanges,+) where++import Control.Applicative ((<|>))+import Control.Monad (guard)+import Control.Monad.Error.Class (MonadError, throwError)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as B+import Data.ByteString.Internal (isSpaceChar8)+import Data.List qualified as L+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Maybe (fromMaybe, isJust, mapMaybe)+import Data.Set (Set)+import Data.Set qualified as S+import Distribution.CabalSpecVersion (CabalSpecVersion (CabalSpecV1_0, CabalSpecV3_0))+import Distribution.Fields (+ Field (..),+ FieldLine (..),+ Name (..),+ SectionArg (..),+ readFields,+ )+import Distribution.PackageDescription (+ ComponentName (..),+ Dependency,+ GenericPackageDescription (..),+ LibraryName (..),+ PackageDescription (..),+ componentNameStanza,+ componentNameString,+ pkgName,+ unPackageName,+ unUnqualComponentName,+ )+import Distribution.PackageDescription.Configuration (flattenPackageDescription)+import Distribution.PackageDescription.Parsec (+ parseGenericPackageDescription,+ parseGenericPackageDescriptionMaybe,+ runParseResult,+ )+import Distribution.Parsec (+ Position (..),+ eitherParsec,+ showPError,+ )+import Distribution.Simple.BuildTarget (+ BuildTarget (BuildTargetComponent),+ readUserBuildTargets,+ resolveBuildTargets,+ )++-- | Just a newtype wrapper, since @Cabal-syntax@ does not provide any.+newtype CommonStanza = CommonStanza {unCommonStanza :: ByteString}+ deriving (Eq, Ord, Show)++-- | An input for 'executeConfig'.+data Config = Config+ { cnfOrigContents :: !ByteString+ -- ^ Original Cabal file (with quirks patched,+ -- see "Distribution.PackageDescription.Quirks"),+ -- must be in sync with 'cnfFields'.+ , cnfFields :: ![Field Position]+ -- ^ Parsed (by 'readFields' or, more specifically, by 'parseCabalFile')+ -- representation of the Cabal file,+ -- must be in sync with 'cnfOrigContents'.+ , cnfComponent :: !(Either CommonStanza ComponentName)+ -- ^ Which component to update?+ -- Usually constructed by 'resolveComponent'.+ , cnfDependencies :: !(NonEmpty ByteString)+ -- ^ Which dependencies to add?+ -- Usually constructed by 'validateDependency'.+ }+ deriving (Eq, Show)++extractComponentNames :: GenericPackageDescription -> Set ComponentName+extractComponentNames GenericPackageDescription {..} =+ foldMap (const $ S.singleton $ CLibName LMainLibName) condLibrary+ <> foldMap (S.singleton . CLibName . LSubLibName . fst) condSubLibraries+ <> foldMap (S.singleton . CFLibName . fst) condForeignLibs+ <> foldMap (S.singleton . CExeName . fst) condExecutables+ <> foldMap (S.singleton . CTestName . fst) condTestSuites+ <> foldMap (S.singleton . CBenchName . fst) condBenchmarks++extractCommonStanzas :: [Field ann] -> Set CommonStanza+extractCommonStanzas = foldMap go+ where+ go = \case+ Section (Name _ "common") [SecArgName _pos sectionArg] _subFields ->+ S.singleton $ CommonStanza sectionArg+ Section (Name _ "common") [SecArgStr _pos sectionArg] _subFields ->+ S.singleton $ CommonStanza sectionArg+ _ -> mempty++data Resolution a = NotFound | Resolved a | Ambiguous+ deriving (Functor)++instance Semigroup (Resolution a) where+ a@Resolved {} <> _ = a+ _ <> a@Resolved {} = a+ Ambiguous <> _ = Ambiguous+ _ <> Ambiguous = Ambiguous+ NotFound <> NotFound = NotFound++resolveMainLib :: Set ComponentName -> Resolution ComponentName+resolveMainLib knownNames+ | CLibName LMainLibName `elem` knownNames = Resolved $ CLibName LMainLibName+ | otherwise = NotFound++resolveDefaultComponent :: Set ComponentName -> (ComponentName -> Bool) -> Resolution ComponentName+resolveDefaultComponent knownNames predicate =+ case filter predicate (S.toList knownNames) of+ [] -> NotFound+ [x] -> Resolved x+ _ -> Ambiguous++isCLibName :: ComponentName -> Bool+isCLibName = \case+ CLibName {} -> True+ _ -> False++isCFLibName :: ComponentName -> Bool+isCFLibName = \case+ CFLibName {} -> True+ _ -> False++isCExeName :: ComponentName -> Bool+isCExeName = \case+ CExeName {} -> True+ _ -> False++isCTestName :: ComponentName -> Bool+isCTestName = \case+ CTestName {} -> True+ _ -> False++isCBenchName :: ComponentName -> Bool+isCBenchName = \case+ CBenchName {} -> True+ _ -> False++resolveToComponentName :: Set ComponentName -> Maybe String -> Resolution ComponentName+resolveToComponentName knownNames = \case+ Nothing -> case S.minView knownNames of+ Just (knownName, rest)+ | S.null rest -> Resolved knownName+ _ -> resolveMainLib knownNames+ Just name+ -- Cf. Distribution.Simple.BuildTarget.matchComponentKind+ | name `elem` ["lib", "library"] ->+ resolveMainLib knownNames+ | name `elem` ["flib", "foreign-library"] ->+ resolveDefaultComponent knownNames isCFLibName+ | name `elem` ["exe", "executable"] ->+ resolveDefaultComponent knownNames isCExeName+ | name `elem` ["tst", "test", "test-suite"] ->+ resolveDefaultComponent knownNames isCTestName+ | name `elem` ["bench", "benchmark"] ->+ resolveDefaultComponent knownNames isCBenchName+ | otherwise ->+ resolveDefaultComponent knownNames $ \x -> case componentNameString x of+ Nothing -> False+ Just xs -> unUnqualComponentName xs == name++specialComponents :: Set ComponentName -> Set String+specialComponents knownNames =+ S.fromList $+ mapMaybe isResolvable ["lib", "flib", "exe", "test", "bench"]+ where+ isResolvable xs = case resolveToComponentName knownNames (Just xs) of+ Resolved {} -> Just xs+ _ -> Nothing++resolveToCommonStanza :: Set CommonStanza -> Maybe String -> Resolution CommonStanza+resolveToCommonStanza knownNames (Just (CommonStanza . B.pack -> name))+ | S.member name knownNames = Resolved name+resolveToCommonStanza _ _ = NotFound++isSection :: Field ann -> Bool+isSection = \case+ Field {} -> False+ Section {} -> True++-- | Parse Cabal file into two representations.+parseCabalFile+ :: MonadError String m+ => FilePath+ -- ^ File name, just for error reporting.+ -> ByteString+ -- ^ Contents of the Cabal file.+ -> m ([Field Position], GenericPackageDescription)+ -- ^ Parsed data, suitable for 'resolveComponent'.+parseCabalFile fileName contents = do+ let legacyErr = "Legacy, unsectioned Cabal files are unsupported"+ errorWithCtx msg =+ throwError $+ "Cannot parse input Cabal file "+ ++ fileName+ ++ " because:\n"+ ++ msg++ fields <- case readFields contents of+ Left err -> errorWithCtx $ show err+ Right fs+ | any isSection fs -> pure fs+ | otherwise -> errorWithCtx legacyErr++ packDescr <- case snd $ runParseResult $ parseGenericPackageDescription contents of+ Left (_, err) ->+ errorWithCtx $ L.unlines $ map (showPError fileName) $ NE.toList err+ Right GenericPackageDescription {packageDescription = PackageDescription {specVersion = CabalSpecV1_0}} ->+ errorWithCtx legacyErr+ Right pd -> pure pd++ pure (fields, packDescr)++readBuildTarget :: PackageDescription -> String -> Maybe ComponentName+readBuildTarget pkg targetStr =+ readBuildTarget' pkg targetStr <|> readBuildTarget'' pkg targetStr++readBuildTarget' :: PackageDescription -> String -> Maybe ComponentName+readBuildTarget' pkg targetStr = do+ let (_, utargets) = readUserBuildTargets [targetStr]+ [utarget] <- pure utargets+ let (_, btargets) = resolveBuildTargets pkg [(utarget, False)]+ [BuildTargetComponent btarget] <- pure btargets+ pure btarget++-- | Surprisingly, 'resolveBuildTargets' does not support package component.+-- Let's work around this limitation manually for now.+readBuildTarget'' :: PackageDescription -> String -> Maybe ComponentName+readBuildTarget'' pkg targetStr = do+ (pref, ':' : suff) <- pure $ span (/= ':') targetStr+ guard $ unPackageName (pkgName (package pkg)) == pref+ readBuildTarget' pkg suff++-- | Resolve a raw component name.+resolveComponent+ :: MonadError String m+ => FilePath+ -- ^ File name, just for error reporting.+ -> ([Field Position], GenericPackageDescription)+ -- ^ Parsed Cabal file, as returned by 'parseCabalFile'.+ -> Maybe String+ -- ^ Component name (or default component if 'Nothing'),+ -- roughly adhering to the syntax+ -- of [component targets](https://cabal.readthedocs.io/en/3.12/cabal-commands.html#target-forms).+ -> m (Either CommonStanza ComponentName)+ -- ^ Resolved component.+resolveComponent _ (_, gpd) (Just component)+ | Just cmp <- readBuildTarget (flattenPackageDescription gpd) component =+ pure $ Right cmp+resolveComponent+ fileName+ (extractCommonStanzas -> commonStanzas, extractComponentNames -> componentNames)+ component = case resolution of+ NotFound -> throwError $ case component of+ Nothing ->+ "Default target component not found in "+ ++ fileName+ ++ ".\n"+ ++ knownTargetsHint+ Just cmp ->+ "Target component '"+ ++ cmp+ ++ "' not found in "+ ++ fileName+ ++ ".\n"+ ++ knownTargetsHint+ Resolved cmp -> pure cmp+ Ambiguous ->+ throwError $+ "Target component is ambiguous.\n"+ ++ knownTargetsHint+ where+ allTargets =+ S.fromList (mapMaybe (fmap unUnqualComponentName . componentNameString) (S.toList componentNames))+ <> S.map (B.unpack . unCommonStanza) commonStanzas+ <> specialComponents componentNames+ knownTargetsHint =+ "Specify one with -c: "+ ++ L.intercalate ", " (S.toList allTargets)+ ++ "."+ resolution =+ fmap Right (resolveToComponentName componentNames component)+ <> fmap Left (resolveToCommonStanza commonStanzas component)++-- | Validate [dependency syntax](https://cabal.readthedocs.io/en/3.12/cabal-package-description-file.html#pkg-field-build-depends),+-- checking whether Cabal would be able to parse it.+validateDependency+ :: MonadError String m+ => CabalSpecVersion+ -- ^ Cabal format version to adhere to.+ -> String+ -- ^ Raw dependency to add.+ -> m ByteString+ -- ^ Validated dependency as 'ByteString' (or an error).+validateDependency specVer d = case eitherParsec d of+ Right (_ :: Dependency)+ | specVer < CabalSpecV3_0 && elem ':' d ->+ throwError $+ "Cannot use the specified dependency '"+ ++ d+ ++ "' because cabal-version must be at least 3.0."+ | otherwise -> pure $ B.pack d+ Left err ->+ throwError $+ "Cannot parse the specified dependency '"+ ++ d+ ++ "' because:\n"+ ++ err++-- Both lines and rows are 1-based.+splitAtPosition :: Position -> ByteString -> (ByteString, ByteString)+splitAtPosition (Position line row) bs+ | line <= 1 = B.splitAt (row - 1) bs+ | otherwise = case L.drop (line - 2) nls of+ [] -> (bs, mempty)+ nl : _ -> B.splitAt (nl + row) bs+ where+ nls = B.elemIndices '\n' bs++splitAtPositionLine :: Position -> ByteString -> (ByteString, ByteString)+splitAtPositionLine (Position line _row) = splitAtPosition (Position line 1)++isComponent :: Either CommonStanza ComponentName -> Field a -> Bool+isComponent (Right cmp) = \case+ Section (Name _ "library") [] _subFields+ | cmp == CLibName LMainLibName ->+ True+ Section (Name _ sectionName) [SecArgName _pos sectionArg] _subFields+ | sectionName <> " " <> sectionArg == B.pack (componentNameStanza cmp) ->+ True+ Section (Name _ sectionName) [SecArgStr _pos sectionArg] _subFields+ | sectionName <> " " <> sectionArg == B.pack (componentNameStanza cmp) ->+ True+ _ -> False+isComponent (Left (CommonStanza commonName)) = \case+ Section (Name _ "common") [SecArgName _pos sectionArg] _subFields ->+ sectionArg == commonName+ Section (Name _ "common") [SecArgStr _pos sectionArg] _subFields ->+ sectionArg == commonName+ _ -> False++findNonImportField :: [Field Position] -> Maybe Position+findNonImportField (Section _ _ subFields : rest) =+ case filter (not . isImportField) subFields of+ fld : _ -> Just $ getFieldNameAnn fld+ [] -> case rest of+ fld : _ -> case getFieldNameAnn fld of+ Position line _ -> Just (Position line defaultRow)+ [] -> Just (Position maxBound defaultRow)+ where+ defaultRow = case reverse subFields of+ [] -> 3+ fld : _ -> case getFieldNameAnn fld of+ Position _ row -> row+findNonImportField _ = Nothing++isImportField :: Field a -> Bool+isImportField = \case+ Field (Name _ fieldName) _ -> fieldName == "import"+ Section {} -> False++getFieldNameAnn :: Field ann -> ann+getFieldNameAnn = \case+ Field (Name ann _) _ -> ann+ Section (Name ann _) _ _ -> ann++isBuildDependsField :: Field ann -> Bool+isBuildDependsField = \case+ Field (Name _ "build-depends") _ -> True+ _ -> False++detectLeadingComma :: ByteString -> Maybe ByteString+detectLeadingComma xs = case B.uncons xs of+ Just (',', ys) -> Just $ B.cons ',' $ B.takeWhile (== ' ') ys+ _ -> Nothing++dropRepeatingSpaces :: ByteString -> ByteString+dropRepeatingSpaces xs = case B.uncons xs of+ Just (' ', ys) -> B.cons ' ' (B.dropWhile (== ' ') ys)+ _ -> xs++-- | Find build-depends section and insert new+-- dependencies at the beginning, trying our best+-- 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+ component <- L.find (isComponent cnfComponent) cnfFields+ Section _ _ subFields <- pure component+ buildDependsField <- L.find isBuildDependsField subFields+ Field _ (FieldLine firstDepPos _dep : restDeps) <- pure buildDependsField++ -- This is not really the second dependency:+ -- it's a dependency on the next line.+ let secondDepPos = case restDeps of+ FieldLine pos _dep : _ -> Just pos+ _ -> Nothing+ fillerPred c = isSpaceChar8 c || c == ','++ let (B.takeWhileEnd fillerPred -> pref, B.takeWhile fillerPred -> suff) =+ splitAtPosition firstDepPos cnfOrigContents+ prefSuff = pref <> suff++ (afterLast, inBetween, beforeFirst) = case secondDepPos of+ Nothing ->+ ( if B.any (== ',') prefSuff then pref' else "," <> pref'+ , if B.any (== ',') prefSuff then prefSuff' else "," <> prefSuff'+ , suff+ )+ where+ prefSuff' = dropRepeatingSpaces prefSuff+ pref' = dropRepeatingSpaces pref+ Just pos ->+ ( if B.any (== ',') suff then pref1 else prefSuff1+ , prefSuff1+ , suff+ )+ where+ prefSuff1 = pref1 <> suff1+ (B.takeWhileEnd fillerPred -> pref1, B.takeWhile fillerPred -> suff1) =+ splitAtPosition pos cnfOrigContents++ let (beforeFirstDep, afterFirstDep) = splitAtPosition firstDepPos cnfOrigContents+ newBuildDeps = beforeFirst <> B.intercalate inBetween (NE.toList cnfDependencies) <> afterLast++ 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++-- | 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 isSpaceChar8 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++-- | The main workhorse, adding dependencies to a specified component+-- in the Cabal file.+executeConfig+ :: (Either CommonStanza ComponentName -> ByteString -> Bool)+ -- ^ How to validate results? See 'validateChanges'.+ -> Config+ -- ^ Input arguments.+ -> Maybe ByteString+ -- ^ Updated contents, if validated successfully.+executeConfig validator cnf@Config {cnfComponent} =+ L.find (validator cnfComponent) $+ mapMaybe ($ cnf) [fancyAlgorithm, niceAlgorithm, roughAlgorithm]++-- | Validate that updates did not cause unexpected effects on other sections+-- of the Cabal file.+validateChanges+ :: GenericPackageDescription+ -- ^ Original package description.+ -> Either CommonStanza ComponentName+ -- ^ Which component was supposed to be updated?+ -- Usually constructed by 'resolveComponent'.+ -> ByteString+ -- ^ Update Cabal file.+ -> Bool+ -- ^ Was the update successful?+validateChanges origPackDesc (Left _commonStanza) newContents =+ case parseGenericPackageDescriptionMaybe newContents of+ Nothing -> False+ Just newPackDesc ->+ packageDescription origPackDesc == packageDescription newPackDesc+ && gpdScannedVersion origPackDesc == gpdScannedVersion newPackDesc+ && genPackageFlags origPackDesc == genPackageFlags newPackDesc+validateChanges origPackDesc (Right component) newContents =+ case parseGenericPackageDescriptionMaybe newContents of+ Nothing -> False+ Just newPackDesc ->+ packageDescription origPackDesc == packageDescription newPackDesc+ && gpdScannedVersion origPackDesc == gpdScannedVersion newPackDesc+ && genPackageFlags origPackDesc == genPackageFlags newPackDesc+ && mainLibMatch+ && subLibsMatch+ && foreignLibsMatch+ && executablesMatch+ && testsMatch+ && benchmarksMatch+ where+ mainLibMatch = case (condLibrary origPackDesc, condLibrary newPackDesc) of+ (Nothing, Nothing) -> True+ (Just x, Just y) -> component == CLibName LMainLibName || x == y+ _ -> False++ subLibsMatch = length xs == length ys && and (zipWith predicate xs ys)+ where+ xs = condSubLibraries origPackDesc+ ys = condSubLibraries newPackDesc+ predicate x y = x == y || isCLibName component && fst x == fst y && componentNameString component == Just (fst x)++ foreignLibsMatch = length xs == length ys && and (zipWith predicate xs ys)+ where+ xs = condForeignLibs origPackDesc+ ys = condForeignLibs newPackDesc+ predicate x y = x == y || isCFLibName component && fst x == fst y && componentNameString component == Just (fst x)++ executablesMatch = length xs == length ys && and (zipWith predicate xs ys)+ where+ xs = condExecutables origPackDesc+ ys = condExecutables newPackDesc+ predicate x y = x == y || isCExeName component && fst x == fst y && componentNameString component == Just (fst x)++ testsMatch = length xs == length ys && and (zipWith predicate xs ys)+ where+ xs = condTestSuites origPackDesc+ ys = condTestSuites newPackDesc+ predicate x y = x == y || isCTestName component && fst x == fst y && componentNameString component == Just (fst x)++ benchmarksMatch = length xs == length ys && and (zipWith predicate xs ys)+ where+ xs = condBenchmarks origPackDesc+ ys = condBenchmarks newPackDesc+ predicate x y = x == y || isCBenchName component && fst x == fst y && componentNameString component == Just (fst x)
+ tests/Main.hs view
@@ -0,0 +1,1406 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Copyright: (c) 2023 Bodigrim+-- License: BSD-3-Clause+module Main (main) where++import Data.Algorithm.Diff (Diff, PolyDiff (..), getDiff)+import Data.Char (isAlpha)+import Data.Maybe (mapMaybe)+import Data.String.QQ (s)+import System.Directory (findExecutable)+import System.Exit (ExitCode (..))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (cwd, proc, readCreateProcessWithExitCode)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed)++data CabalAddTest = CabalAddTest+ { catName :: String+ , catArgs :: [String]+ , catInput :: String+ , catOutput :: String+ }++instance IsTest CabalAddTest where+ testOptions = pure []+ run _opts CabalAddTest {..} _yieldProgress = do+ mCabalAddExe <- findExecutable "cabal-add"+ case mCabalAddExe of+ Nothing -> pure $ testFailed "cabal-add executable is not in PATH"+ Just cabalAddExe -> do+ let template = map (\c -> if isAlpha c then c else '_') catName+ withSystemTempDirectory template $ \tempDir -> do+ let cabalFileName = tempDir ++ "/" ++ template ++ ".cabal"+ writeFile cabalFileName catInput+ let crpr = (proc cabalAddExe catArgs) {cwd = Just tempDir}+ (code, _out, err) <- readCreateProcessWithExitCode crpr ""+ case code of+ ExitFailure {} -> pure $ testFailed err+ ExitSuccess -> do+ output <- readFile cabalFileName+ pure $+ if output == catOutput+ then testPassed ""+ else testFailed $ prettyDiff $ getDiff (lines catOutput) (lines output)++prettyDiff :: [Diff String] -> String+prettyDiff =+ unlines+ . mapMaybe+ ( \case+ First xs -> Just $ '-' : xs+ Second ys -> Just $ '+' : ys+ Both xs _ -> Just $ ' ' : xs+ )++mkTest :: CabalAddTest -> TestTree+mkTest cat = singleTest (catName cat) cat++caseMultipleDependencies1 :: TestTree+caseMultipleDependencies1 =+ mkTest $+ CabalAddTest+ { catName = "add multiple dependencies 1"+ , catArgs = ["foo < 1 && >0.7", "baz ^>= 2.0"]+ , catInput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends:+ foo < 1 && >0.7,+ baz ^>= 2.0,+ base >=4.15 && <5+|]+ }++caseMultipleDependencies2 :: TestTree+caseMultipleDependencies2 =+ mkTest $+ CabalAddTest+ { catName = "add multiple dependencies 2"+ , catArgs = ["foo < 1 && >0.7", "baz ^>= 2.0"]+ , catInput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends: base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends: foo < 1 && >0.7, baz ^>= 2.0, base >=4.15 && <5+|]+ }++caseMultipleDependencies3 :: TestTree+caseMultipleDependencies3 =+ mkTest $+ CabalAddTest+ { catName = "add multiple dependencies 3"+ , catArgs = ["foo < 1 && >0.7", "baz ^>= 2.0"]+ , catInput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends: base >=4.15 && <5,+ containers+|]+ , catOutput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends: foo < 1 && >0.7,+ baz ^>= 2.0,+ base >=4.15 && <5,+ containers+|]+ }++caseMultipleDependencies4 :: TestTree+caseMultipleDependencies4 =+ mkTest $+ CabalAddTest+ { catName = "add multiple dependencies 4"+ , catArgs = ["foo < 1 && >0.7", "baz ^>= 2.0"]+ , catInput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends: base >=4.15 && <5+ , containers+ , deepseq+|]+ , catOutput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends: foo < 1 && >0.7+ , baz ^>= 2.0+ , base >=4.15 && <5+ , containers+ , deepseq+|]+ }++caseLibraryInDescription :: TestTree+caseLibraryInDescription =+ mkTest $+ CabalAddTest+ { catName = "word 'library' in description"+ , catArgs = ["foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple+description:+ A library of basic functionality.++library+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.13.0.0+cabal-version: 2.0+build-type: Simple+description:+ A library of basic functionality.++library+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseImportFields1 :: TestTree+caseImportFields1 =+ mkTest $+ CabalAddTest+ { catName = "import fields 1"+ , catArgs = ["foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+cabal-version: 2.2+name: dummy+version: 0.13.0.0+build-type: Simple++common foo+ build-depends: bar++library+ import: foo+ exposed-modules: Foo+|]+ , catOutput =+ [s|+cabal-version: 2.2+name: dummy+version: 0.13.0.0+build-type: Simple++common foo+ build-depends: bar++library+ import: foo+ build-depends: foo < 1 && >0.7, quux < 1+ exposed-modules: Foo+|]+ }++caseImportFields2 :: TestTree+caseImportFields2 =+ mkTest $+ CabalAddTest+ { catName = "import fields 2"+ , catArgs = ["foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+cabal-version: 2.2+name: dummy+version: 0.13.0.0+build-type: Simple++common foo+ build-depends: bar++library+ Import : foo+ exposed-modules: Foo+|]+ , catOutput =+ [s|+cabal-version: 2.2+name: dummy+version: 0.13.0.0+build-type: Simple++common foo+ build-depends: bar++library+ Import : foo+ build-depends: foo < 1 && >0.7, quux < 1+ exposed-modules: Foo+|]+ }++caseImportFields3 :: TestTree+caseImportFields3 =+ mkTest $+ CabalAddTest+ { catName = "import fields 3"+ , catArgs = ["foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+cabal-version: 2.2+name: dummy+version: 0.13.0.0+build-type: Simple++common foo+ build-depends: bar++library+ Import : foo+|]+ , catOutput =+ [s|+cabal-version: 2.2+name: dummy+version: 0.13.0.0+build-type: Simple++common foo+ build-depends: bar++library+ Import : foo+ build-depends: foo < 1 && >0.7, quux < 1+|]+ }++caseSublibraryTarget1 :: TestTree+caseSublibraryTarget1 =+ mkTest $+ CabalAddTest+ { catName = "sublibrary target 1"+ , catArgs = ["foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++library baz+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++library baz+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseSublibraryTarget2 :: TestTree+caseSublibraryTarget2 =+ mkTest $+ CabalAddTest+ { catName = "sublibrary target 2"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends:+ base >=4.15 && <5++library baz+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++library+ build-depends:+ base >=4.15 && <5++library baz+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseExecutableTarget1 :: TestTree+caseExecutableTarget1 =+ mkTest $+ CabalAddTest+ { catName = "executable target 1"+ , catArgs = ["exe", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseExecutableTarget2 :: TestTree+caseExecutableTarget2 =+ mkTest $+ CabalAddTest+ { catName = "executable target 2"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseExecutableTarget3 :: TestTree+caseExecutableTarget3 =+ mkTest $+ CabalAddTest+ { catName = "executable target 3"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable "baz"+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable "baz"+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseExecutableTarget4 :: TestTree+caseExecutableTarget4 =+ mkTest $+ CabalAddTest+ { catName = "executable target 4"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common baz+ language: Haskell2010++executable baz+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common baz+ language: Haskell2010++executable baz+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseTestTarget1 :: TestTree+caseTestTarget1 =+ mkTest $+ CabalAddTest+ { catName = "test target 1"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common baz+ language: Haskell2010++test-suite baz+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common baz+ language: Haskell2010++test-suite baz+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseTestTarget2 :: TestTree+caseTestTarget2 =+ mkTest $+ CabalAddTest+ { catName = "test target 2"+ , catArgs = ["test:baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common baz+ language: Haskell2010++test-suite baz+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common baz+ language: Haskell2010++test-suite baz+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseCommonStanzaTarget1 :: TestTree+caseCommonStanzaTarget1 =+ mkTest $+ CabalAddTest+ { catName = "common stanza as a target 1"+ , catArgs = ["foo", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common foo+ language: Haskell2010+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++common foo+ build-depends: foo < 1 && >0.7, quux < 1+ language: Haskell2010+|]+ }++caseCommonStanzaTarget2 :: TestTree+caseCommonStanzaTarget2 =+ mkTest $+ CabalAddTest+ { catName = "common stanza as a target 2"+ , catArgs = ["foo", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++Common foo+ language: Haskell2010+ build-depends:+ , base+ , containers+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++Common foo+ language: Haskell2010+ build-depends:+ , foo < 1 && >0.7+ , quux < 1+ , base+ , containers+|]+ }++caseTwoSpacesInStanza :: TestTree+caseTwoSpacesInStanza =+ mkTest $+ CabalAddTest+ { catName = "two spaces in stanza"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseTitleCaseStanza1 :: TestTree+caseTitleCaseStanza1 =+ mkTest $+ CabalAddTest+ { catName = "title case in stanza 1"+ , catArgs = ["foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++Library+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++Library+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseTitleCaseStanza2 :: TestTree+caseTitleCaseStanza2 =+ mkTest $+ CabalAddTest+ { catName = "title case in stanza 2"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++Executable baz+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++Executable baz+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseTitleCaseBuildDepends :: TestTree+caseTitleCaseBuildDepends =+ mkTest $+ CabalAddTest+ { catName = "title case in build-depends"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ Build-Depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+ Build-Depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++caseSharedComponentPrefixes :: TestTree+caseSharedComponentPrefixes =+ mkTest $+ CabalAddTest+ { catName = "shared component prefixes"+ , catArgs = ["baz", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable bazzzy+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5++executable baz+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable bazzzy+ main-is: Main.hs+ build-depends:+ base >=4.15 && <5++executable baz+ main-is: Main.hs+ build-depends:+ foo < 1 && >0.7,+ quux < 1,+ base >=4.15 && <5+|]+ }++windowsLineEndings :: TestTree+windowsLineEndings =+ mkTest $+ CabalAddTest+ { catName = "Windows line endings"+ , catArgs = ["exe", "foo < 1 && >0.7", "quux < 1"]+ , catInput =+ convertToWindowsLineEndings+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ main-is: Main.hs+|]+ , catOutput =+ convertToWindowsLineEndings+ [s|+name: dummy+version: 0.1.0.0+cabal-version: 2.0+build-type: Simple++executable baz+ build-depends: foo < 1 && >0.7, quux < 1+ main-is: Main.hs+|]+ }+ where+ convertToWindowsLineEndings :: String -> String+ convertToWindowsLineEndings = concatMap (\c -> if c == '\n' then ['\r', '\n'] else [c])++caseLeadingComma1 :: TestTree+caseLeadingComma1 =+ mkTest $+ CabalAddTest+ { catName = "build-depends start from comma 1"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends:+ , base >=4.15 && <5+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends:+ , baz ^>= 2.0+ , quux < 1+ , base >=4.15 && <5+|]+ }++caseLeadingComma2 :: TestTree+caseLeadingComma2 =+ mkTest $+ CabalAddTest+ { catName = "build-depends start from comma 2"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: ,base >=4.15 && <5+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: ,baz ^>= 2.0 ,quux < 1 ,base >=4.15 && <5+|]+ }++caseLeadingComma3 :: TestTree+caseLeadingComma3 =+ mkTest $+ CabalAddTest+ { catName = "build-depends start from comma 3"+ , catArgs = ["baz ^>= 2.0", "quux > 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: ,base >=4.15 && <5+ ,containers+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: ,baz ^>= 2.0+ ,quux > 1+ ,base >=4.15 && <5+ ,containers+|]+ }++caseConditionalBuildDepends :: TestTree+caseConditionalBuildDepends =+ mkTest $+ CabalAddTest+ { catName = "build-depends are under condition"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ if impl(ghc >= 9.6)+ build-depends:+ base >=4.15 && <5+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: baz ^>= 2.0, quux < 1+ if impl(ghc >= 9.6)+ build-depends:+ base >=4.15 && <5+|]+ }++caseEmptyComponent1 :: TestTree+caseEmptyComponent1 =+ mkTest $+ CabalAddTest+ { catName = "empty component 1"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library++executable bar+ main-is: Bar.hs+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library++ build-depends: baz ^>= 2.0, quux < 1++executable bar+ main-is: Bar.hs+|]+ }++caseEmptyComponent2 :: TestTree+caseEmptyComponent2 =+ mkTest $+ CabalAddTest+ { catName = "empty component 2"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: baz ^>= 2.0, quux < 1+|]+ }++caseEmptyComponent3 :: TestTree+caseEmptyComponent3 =+ mkTest $+ CabalAddTest+ { catName = "empty component 3"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: baz ^>= 2.0, quux < 1+|]+ }++caseEmptyBuildDepends :: TestTree+caseEmptyBuildDepends =+ mkTest $+ CabalAddTest+ { catName = "empty build-depends"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends:+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++library+ build-depends: baz ^>= 2.0, quux < 1+ build-depends:+|]+ }++caseComponentInBraces :: TestTree+caseComponentInBraces =+ mkTest $+ CabalAddTest+ { catName = "component in figure braces"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++Library {+ Build-Depends: base >= 4 && < 5+}+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++Library {+ Build-Depends: baz ^>= 2.0, quux < 1, base >= 4 && < 5+}+|]+ }++caseCommentsWithCommas :: TestTree+caseCommentsWithCommas =+ mkTest $+ CabalAddTest+ { catName = "comments with commas"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ main-is: Main.hs+ build-depends: magda,+ -- Something, which+ -- contains commas.+ base+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ main-is: Main.hs+ build-depends: baz ^>= 2.0, quux < 1, magda,+ -- Something, which+ -- contains commas.+ base+|]+ }++caseCommentsWithoutCommas :: TestTree+caseCommentsWithoutCommas =+ mkTest $+ CabalAddTest+ { catName = "comments without commas"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ main-is: Main.hs+ build-depends: magda,+ -- Something without commas+ base+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ main-is: Main.hs+ build-depends: baz ^>= 2.0, quux < 1, magda,+ -- Something without commas+ base+|]+ }++caseDependenciesOnTheSameLine :: TestTree+caseDependenciesOnTheSameLine =+ mkTest $+ CabalAddTest+ { catName = "all build-deps on the same line"+ , catArgs = ["baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: magda, base+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: baz ^>= 2.0, quux < 1, magda, base+|]+ }++caseIgnoreAddArgument :: TestTree+caseIgnoreAddArgument =+ mkTest $+ CabalAddTest+ { catName = "ignore add as the first command-line argument"+ , catArgs = ["add", "baz ^>= 2.0", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: magda, base+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: baz ^>= 2.0, quux < 1, magda, base+|]+ }++caseDoNotIgnoreAddArgument :: TestTree+caseDoNotIgnoreAddArgument =+ mkTest $+ CabalAddTest+ { catName = "do not ignore add as the second command-line argument"+ , catArgs = ["baz ^>= 2.0", "add", "quux < 1"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: magda, base+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: baz ^>= 2.0, add, quux < 1, magda, base+|]+ }++caseSublibraryDependency :: TestTree+caseSublibraryDependency =+ mkTest $+ CabalAddTest+ { catName = "sublibrary as a dependency"+ , catArgs = ["foo:bar"]+ , catInput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: magda, base+|]+ , catOutput =+ [s|+cabal-version: 3.6+name: dummy+version: 0.1+build-type: Simple++executable dagda+ build-depends: foo:bar, magda, base+|]+ }++main :: IO ()+main =+ defaultMain $+ testGroup+ "All"+ [ caseMultipleDependencies1+ , caseMultipleDependencies2+ , caseMultipleDependencies3+ , caseMultipleDependencies4+ , caseLibraryInDescription+ , caseImportFields1+ , caseImportFields2+ , caseImportFields3+ , caseSublibraryTarget1+ , caseSublibraryTarget2+ , caseExecutableTarget1+ , caseExecutableTarget2+ , caseExecutableTarget3+ , caseExecutableTarget4+ , caseTestTarget1+ , caseTestTarget2+ , caseCommonStanzaTarget1+ , caseCommonStanzaTarget2+ , caseTwoSpacesInStanza+ , caseTitleCaseStanza1+ , caseTitleCaseStanza2+ , caseTitleCaseBuildDepends+ , caseSharedComponentPrefixes+ , windowsLineEndings+ , caseLeadingComma1+ , caseLeadingComma2+ , caseLeadingComma3+ , caseConditionalBuildDepends+ , caseEmptyComponent1+ , caseEmptyComponent2+ , caseEmptyComponent3+ , caseEmptyBuildDepends+ , caseComponentInBraces+ , caseCommentsWithCommas+ , caseCommentsWithoutCommas+ , caseDependenciesOnTheSameLine+ , caseIgnoreAddArgument+ , caseDoNotIgnoreAddArgument+ , caseSublibraryDependency+ ]