diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## 0.2.1 + +* Migrate the executable from `cabal-install-parsers` to `cabal-install` proper. +* Do not attempt to rename entities inside comments. + ## 0.2 * Allow add not only dependencies, but also modules. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,33 +1,50 @@ {-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- | -- 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 Control.Monad.IO.Class (liftIO) import Data.Bifunctor (bimap) 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, isJust) +import Data.Maybe (catMaybes, isJust, mapMaybe) import Distribution.CabalSpecVersion (CabalSpecVersion) import Distribution.Client.Add +import Distribution.Client.DistDirLayout ( + defaultDistDirLayout, + distProjectRootDirectory, + ) +import Distribution.Client.HttpUtils (configureTransport) +import Distribution.Client.ProjectConfig ( + ProjectPackageLocation (..), + findProjectPackages, + findProjectRoot, + readProjectConfig, + ) +import Distribution.Client.RebuildMonad (runRebuild) import Distribution.PackageDescription ( ComponentName, GenericPackageDescription, + ignoreConditions, packageDescription, specVersion, ) import Distribution.PackageDescription.Quirks (patchQuirks) +import Distribution.Verbosity qualified as Verbosity import Options.Applicative ( Parser, execParser, @@ -46,8 +63,12 @@ import System.Directory (doesFileExist, listDirectory) import System.Environment (getArgs, lookupEnv, withArgs) import System.Exit (die) -import System.FilePath (takeDirectory, ()) +import System.FilePath (splitFileName, ()) +#if MIN_VERSION_Cabal(3,17,0) +import Distribution.Client.ProjectConfig (ProjectFileParser(..)) +#endif + data RawConfig = RawConfig { rcnfMProjectFile :: !(Maybe FilePath) , rcnfArgs :: !(NonEmpty String) @@ -94,14 +115,49 @@ 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 + let (projectDir, projectFile) = splitFileName projectFn + mProjectRoot <- findProjectRoot silent (Just projectDir) (Just projectFile) + case mProjectRoot of Left exc -> throwIO exc - Right prj -> pure $ map (takeDirectory projectFn ) $ prjPackages prj + Right projectRoot -> do + let dirLayout = defaultDistDirLayout projectRoot Nothing Nothing + rootDirectory = distProjectRootDirectory dirLayout + runRebuild rootDirectory $ do + httpTransport <- liftIO $ configureTransport silent [] Nothing + skeleton <- readProjectConfigSilently httpTransport mempty mempty dirLayout + let projectConfig = fromSkeleton skeleton + packages <- findProjectPackages dirLayout projectConfig + pure $ map (rootDirectory ) $ mapMaybe extractCabalFileFromProjectPackageLocation packages + +#if MIN_VERSION_Cabal(3,17,0) +silent :: Verbosity.Verbosity +silent = Verbosity.Verbosity { verbosityFlags = Verbosity.silent, verbosityHandles = Verbosity.defaultVerbosityHandles } +#else +silent :: Verbosity.Verbosity +silent = Verbosity.silent +#endif + +#if MIN_VERSION_Cabal(3,17,0) +readProjectConfigSilently :: _ +readProjectConfigSilently = readProjectConfig silent ParsecParser +#else +readProjectConfigSilently :: _ +readProjectConfigSilently = readProjectConfig silent +#endif + +#if MIN_VERSION_Cabal(3,17,0) +fromSkeleton :: _ +fromSkeleton = snd . ignoreConditions +#else +fromSkeleton :: _ +fromSkeleton = fst . ignoreConditions +#endif + +extractCabalFileFromProjectPackageLocation :: ProjectPackageLocation -> Maybe FilePath +extractCabalFileFromProjectPackageLocation = \case + ProjectPackageLocalCabalFile fn -> Just fn + ProjectPackageLocalDirectory _dn fn -> Just fn + _ -> Nothing resolveCabalFiles :: Maybe FilePath -> IO [FilePath] resolveCabalFiles = \case diff --git a/cabal-add.cabal b/cabal-add.cabal --- a/cabal-add.cabal +++ b/cabal-add.cabal @@ -1,12 +1,13 @@ cabal-version: 3.0 name: cabal-add -version: 0.2 +version: 0.2.1 license: BSD-3-Clause license-file: LICENSE maintainer: andrew.lelechenko@gmail.com author: Bodigrim tested-with: - ghc ==9.12.2 ghc ==9.10.2 ghc ==9.8.4 ghc ==9.6.7 ghc ==9.4.8 + ghc ==9.14.1 ghc ==9.12.2 ghc ==9.10.3 ghc ==9.8.4 ghc ==9.6.7 + ghc ==9.4.8 synopsis: Extend Cabal build-depends from the command line description: @@ -37,8 +38,8 @@ build-depends: base <5, bytestring <0.13, - Cabal >=3.8 && <3.15, - Cabal-syntax >=3.8 && <3.15, + Cabal >=3.8 && <3.19, + Cabal-syntax >=3.8 && <3.19, containers <0.9, mtl <2.4 @@ -51,12 +52,12 @@ base <5, bytestring <0.13, cabal-add, - cabal-install-parsers >=0.4.1 && <0.7, + Cabal, + cabal-install >=3.12 && <3.19, Cabal-syntax, directory <1.4, filepath <1.6, - optparse-applicative >=0.16 && <0.20, - process <1.7 + optparse-applicative >=0.16 && <0.20 test-suite cabal-add-tests type: exitcode-stdio-1.0 @@ -64,21 +65,25 @@ build-tool-depends: cabal-add:cabal-add hs-source-dirs: tests default-language: GHC2021 + other-extensions: MultilineStrings ghc-options: -Wall build-depends: base <5, + bytestring >=0.11.2, Diff >=0.4, directory, + file-io, + filepath, process, - string-qq, tasty, - temporary + temporary-ospath <1.4 test-suite cabal-add-unit-tests type: exitcode-stdio-1.0 main-is: UnitTests.hs hs-source-dirs: tests/ default-language: GHC2021 + other-extensions: MultilineStrings ghc-options: -Wall build-depends: base <5, @@ -86,8 +91,4 @@ Cabal, cabal-add, Diff >=0.4, - directory, - process, - string-qq, - tasty, - temporary + tasty diff --git a/src/Distribution/Client/Add.hs b/src/Distribution/Client/Add.hs --- a/src/Distribution/Client/Add.hs +++ b/src/Distribution/Client/Add.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -69,6 +70,10 @@ resolveBuildTargets, ) +#if MIN_VERSION_Cabal_syntax(3,17,0) +import Distribution.Fields (perror) +#endif + -- | An input for 'executeAddConfig'. data AddConfig = AddConfig { cnfOrigContents :: !ByteString @@ -229,12 +234,18 @@ packDescr <- case snd $ runParseResult $ parseGenericPackageDescription contents of Left (_, err) -> - errorWithCtx $ L.unlines $ map (showPError fileName) $ NE.toList err + errorWithCtx $ L.unlines $ map (showPError fileName . toPError) $ NE.toList err Right GenericPackageDescription {packageDescription = PackageDescription {specVersion = CabalSpecV1_0}} -> errorWithCtx legacyErr Right pd -> pure pd pure (fields, packDescr) + where +#if MIN_VERSION_Cabal_syntax(3,17,0) + toPError = perror +#else + toPError = id +#endif readBuildTarget :: PackageDescription -> String -> Maybe ComponentName readBuildTarget pkg targetStr = diff --git a/src/Distribution/Client/Rename.hs b/src/Distribution/Client/Rename.hs --- a/src/Distribution/Client/Rename.hs +++ b/src/Distribution/Client/Rename.hs @@ -16,9 +16,9 @@ ) where import Data.ByteString (ByteString) +import Data.ByteString.Builder qualified as Builder import Data.ByteString.Char8 qualified as B import Data.Char (isPunctuation, isSpace) -import Data.Foldable (fold) import Data.List qualified as L import Distribution.Client.Add ( TargetField (..), @@ -77,14 +77,14 @@ executeRenameConfig validator RenameConfig {cnfFields, cnfComponent, cnfOrigContents, cnfRenameFrom, cnfRenameTo, cnfTargetField} = do let fieldsWithSource = annotateFieldsWithSource cnfOrigContents cnfFields fieldsWithSource' = map replaceInSection fieldsWithSource - newContents = foldMap fold fieldsWithSource' + newContents = B.toStrict $ Builder.toLazyByteString $ foldMap (foldMap Builder.byteString) fieldsWithSource' if validator cnfComponent newContents then Just newContents else Nothing where replaceInBS :: ByteString -> ByteString replaceInBS hay | B.null rest = hay - | not startsWithBoundary || not endsWithBoundary = + | not startsWithBoundary || not endsWithBoundary || B.elem '\n' pref = pref <> cnfRenameFrom <> replaceInBS suff | otherwise = pref <> cnfRenameTo <> replaceInBS suff diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,1434 +1,1448 @@ {-# 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, env, proc, readCreateProcessWithExitCode) -import Test.Tasty (TestTree, defaultMain, testGroup) -import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed) - -data CabalAddTest = CabalAddTest - { catName :: String - , catArgs :: [String] - , catEnv :: [(String, 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, env = Just catEnv} - (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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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"] - , catEnv = [("CABAL", "/fake/usr/bin/local/cabal")] - , 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"] - , catEnv = mempty - , 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"] - , catEnv = mempty - , 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 -|] - } - -caseSpecialDependencyName1 :: TestTree -caseSpecialDependencyName1 = - mkTest $ - CabalAddTest - { catName = "add dependency named 'add'" - , catArgs = ["add"] - , catEnv = mempty - , 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: - add, - base >=4.15 && <5 -|] +{-# LANGUAGE MultilineStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} + +{- HLINT ignore "Avoid restricted function" -} + +-- | +-- Copyright: (c) 2023 Bodigrim +-- License: BSD-3-Clause +module Main (main) where + +import Data.Algorithm.Diff (Diff, PolyDiff (..), getDiff) +import Data.ByteString.Lazy (LazyByteString) +import Data.ByteString.Lazy.Char8 qualified as BL +import Data.Char (isAlpha) +import Data.Maybe (mapMaybe) +import Data.String (fromString) +import System.Directory (findExecutable) +import System.Exit (ExitCode (..)) +import System.File.OsPath (readFile, writeFile) +import System.IO.Temp.OsPath (withSystemTempDirectory) +import System.IO.Unsafe (unsafePerformIO) +import System.OsPath (decodeFS, encodeFS, osp, (<.>), ()) +import System.Process (cwd, env, proc, readCreateProcessWithExitCode) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.Providers (IsTest (..), singleTest, testFailed, testPassed) +import Prelude hiding (readFile, writeFile) + +data CabalAddTest = CabalAddTest + { catName :: String + , catArgs :: [String] + , catEnv :: [(String, 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 = unsafePerformIO $ encodeFS $ map (\c -> if isAlpha c then c else '_') catName + withSystemTempDirectory template $ \tempDir -> do + let cabalFileName = tempDir template <.> [osp|cabal|] + writeFile cabalFileName (fromString catInput) + let crpr = + (proc cabalAddExe catArgs) + { cwd = Just $ unsafePerformIO $ decodeFS tempDir + , env = Just catEnv + } + (code, _out, err) <- readCreateProcessWithExitCode crpr "" + case code of + ExitFailure errCode -> pure $ testFailed $ "ExitFailure " ++ show errCode ++ "\n" ++ err + ExitSuccess -> do + output <- readFile cabalFileName + let catOutput' = fromString catOutput + pure $ + if BL.lines output == BL.lines catOutput' + then testPassed "" + else testFailed $ BL.unpack $ prettyDiff $ getDiff (BL.lines catOutput') (BL.lines output) + +prettyDiff :: [Diff LazyByteString] -> LazyByteString +prettyDiff = + BL.unlines + . mapMaybe + ( \case + First xs -> Just $ BL.cons '-' xs + Second ys -> Just $ BL.cons '+' ys + Both xs _ -> Just $ BL.cons ' ' 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + build-depends: + base >=4.15 && <5 + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + build-depends: base >=4.15 && <5 + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + build-depends: base >=4.15 && <5, + containers + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + build-depends: base >=4.15 && <5 + , containers + , deepseq + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 2.2 + name: dummy + version: 0.13.0.0 + build-type: Simple + + common foo + build-depends: bar + + library + Import : foo + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.1.0.0 + cabal-version: 2.0 + build-type: Simple + + library baz + build-depends: + base >=4.15 && <5 + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.1.0.0 + cabal-version: 2.0 + build-type: Simple + + common foo + language: Haskell2010 + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.1.0.0 + cabal-version: 2.0 + build-type: Simple + + Common foo + language: Haskell2010 + build-depends: + , base + , containers + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.1.0.0 + cabal-version: 2.0 + build-type: Simple + + Library + build-depends: + base >=4.15 && <5 + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + convertToWindowsLineEndings + """ + name: dummy + version: 0.1.0.0 + cabal-version: 2.0 + build-type: Simple + + executable baz + main-is: Main.hs + """ + , catOutput = + convertToWindowsLineEndings + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + library + build-depends: + , base >=4.15 && <5 + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + library + build-depends: ,base >=4.15 && <5 + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + library + build-depends: ,base >=4.15 && <5 + ,containers + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + library + + executable bar + main-is: Bar.hs + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + library + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + library""" + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + library + build-depends: + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + Library { + Build-Depends: base >= 4 && < 5 + } + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + 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 = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + executable dagda + build-depends: magda, base + """ + , catOutput = + """ + 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"] + , catEnv = [("CABAL", "/fake/usr/bin/local/cabal")] + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + executable dagda + build-depends: magda, base + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + executable dagda + build-depends: magda, base + """ + , catOutput = + """ + 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"] + , catEnv = mempty + , catInput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + executable dagda + build-depends: magda, base + """ + , catOutput = + """ + cabal-version: 3.6 + name: dummy + version: 0.1 + build-type: Simple + + executable dagda + build-depends: foo:bar, magda, base + """ + } + +caseSpecialDependencyName1 :: TestTree +caseSpecialDependencyName1 = + mkTest $ + CabalAddTest + { catName = "add dependency named 'add'" + , catArgs = ["add"] + , catEnv = mempty + , catInput = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + build-depends: + base >=4.15 && <5 + """ + , catOutput = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + build-depends: + add, + base >=4.15 && <5 + """ } main :: IO () diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs --- a/tests/UnitTests.hs +++ b/tests/UnitTests.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultilineStrings #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} -- | @@ -13,7 +13,6 @@ import Data.ByteString.Char8 qualified as B import Data.List.NonEmpty qualified as NE import Data.Maybe (mapMaybe) -import Data.String.QQ (s) import Distribution.Client.Add (AddConfig (..), TargetField (..), executeAddConfig, parseCabalFile) import Distribution.Client.Rename (RenameConfig (..), executeRenameConfig) import Distribution.Fields.Field (Field) @@ -79,31 +78,31 @@ , cnfOrigContents = inContents } , catOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + 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 -|] + library + build-depends: + foo < 1 && >0.7, + baz ^>= 2.0, + base >=4.15 && <5 + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5 -|] + library + build-depends: + base >=4.15 && <5 + """ caseMultipleExposedModules1 :: TestTree caseMultipleExposedModules1 = @@ -119,31 +118,31 @@ , cnfOrigContents = inContents } , catOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1, Test.Mod2, Main, OtherModule.Mine -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1, Test.Mod2, Main, OtherModule.Mine + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5 - exposed-modules: Main, OtherModule.Mine -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Main, OtherModule.Mine + """ caseMultipleExposedModulesUsingSpaces :: TestTree caseMultipleExposedModulesUsingSpaces = @@ -159,31 +158,31 @@ , cnfOrigContents = inContents } , catOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1 Test.Mod2 Main OtherModule.Mine -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1 Test.Mod2 Main OtherModule.Mine + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5 - exposed-modules: Main OtherModule.Mine -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Main OtherModule.Mine + """ caseMultipleOtherModules :: TestTree caseMultipleOtherModules = @@ -199,45 +198,45 @@ , cnfOrigContents = inContents } , catOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1 Test.Mod2 -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: - Test.Mod1, - Mod3, - Dir.Mod1, - Dir.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1 Test.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: + Test.Mod1, + Mod3, + Dir.Mod1, + Dir.Mod2 + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1 Test.Mod2 -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: - Dir.Mod1, - Dir.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1 Test.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: + Dir.Mod1, + Dir.Mod2 + """ caseMultipleOtherModulesUsingSpaces :: TestTree caseMultipleOtherModulesUsingSpaces = @@ -253,47 +252,47 @@ , cnfOrigContents = inContents } , catOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: - Test.Mod1 - Mod3 - Dir.Mod1 - Dir.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: + Test.Mod1 + Mod3 + Dir.Mod1 + Dir.Mod2 -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1, Test.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1, Test.Mod2 + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: - Dir.Mod1 - Dir.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: + Dir.Mod1 + Dir.Mod2 -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1, Test.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1, Test.Mod2 + """ caseMultipleOtherModulesUsingLeadingCommas :: TestTree caseMultipleOtherModulesUsingLeadingCommas = @@ -309,45 +308,45 @@ , cnfOrigContents = inContents } , catOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: Test.Mod1 - , Mod3 - , Dir.Mod1 - , Dir.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: Test.Mod1 + , Mod3 + , Dir.Mod1 + , Dir.Mod2 -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1, Test.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1, Test.Mod2 + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: Dir.Mod1 - , Dir.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: Dir.Mod1 + , Dir.Mod2 -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1, Test.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1, Test.Mod2 + """ caseMultipleOtherModulesUsingLeadingSpaces :: TestTree caseMultipleOtherModulesUsingLeadingSpaces = @@ -363,45 +362,45 @@ , cnfOrigContents = inContents } , catOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: Test.Mod1 - Mod3 - Dir.Mod1 - Dir.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: Test.Mod1 + Mod3 + Dir.Mod1 + Dir.Mod2 -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1, Test.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1, Test.Mod2 + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -test-suite testss - main-is: Main.hs - type: exitcode-stdio-1.0 - other-modules: Dir.Mod1 - Dir.Mod2 + test-suite testss + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: Dir.Mod1 + Dir.Mod2 -library - build-depends: - base >=4.15 && <5 - exposed-modules: Test.Mod1, Test.Mod2 -|] + library + build-depends: + base >=4.15 && <5 + exposed-modules: Test.Mod1, Test.Mod2 + """ caseMultipleOtherModulesWithImportFields :: TestTree caseMultipleOtherModulesWithImportFields = @@ -417,40 +416,40 @@ , cnfOrigContents = inContents } , catOutput = - [s| -cabal-version: 2.2 -name: dummy -version: 0.13.0.0 -build-type: Simple + """ + cabal-version: 2.2 + name: dummy + version: 0.13.0.0 + build-type: Simple -common foo - build-depends: bar - other-modules: Other + common foo + build-depends: bar + other-modules: Other -library - import: foo - other-modules: This.Dir.Mod1, Mod3 - build-depends: foo < 1 && >0.7, quux < 1 - exposed-modules: Foo -|] + library + import: foo + other-modules: This.Dir.Mod1, Mod3 + build-depends: foo < 1 && >0.7, quux < 1 + exposed-modules: Foo + """ } where inContents = - [s| -cabal-version: 2.2 -name: dummy -version: 0.13.0.0 -build-type: Simple + """ + cabal-version: 2.2 + name: dummy + version: 0.13.0.0 + build-type: Simple -common foo - build-depends: bar - other-modules: Other + common foo + build-depends: bar + other-modules: Other -library - import: foo - build-depends: foo < 1 && >0.7, quux < 1 - exposed-modules: Foo -|] + library + import: foo + build-depends: foo < 1 && >0.7, quux < 1 + exposed-modules: Foo + """ caseMultipleOtherModulesWithImportFields2 :: TestTree caseMultipleOtherModulesWithImportFields2 = @@ -466,40 +465,40 @@ , cnfOrigContents = inContents } , catOutput = - [s| -cabal-version: 2.2 -name: dummy -version: 0.13.0.0 -build-type: Simple + """ + cabal-version: 2.2 + name: dummy + version: 0.13.0.0 + build-type: Simple -common foo - build-depends: bar - other-modules: Other + common foo + build-depends: bar + other-modules: Other -library - Import: foo - other-modules: This.Dir.Mod1, Mod3 - build-depends: foo < 1 && >0.7, quux < 1 - exposed-modules: Foo -|] + library + Import: foo + other-modules: This.Dir.Mod1, Mod3 + build-depends: foo < 1 && >0.7, quux < 1 + exposed-modules: Foo + """ } where inContents = - [s| -cabal-version: 2.2 -name: dummy -version: 0.13.0.0 -build-type: Simple + """ + cabal-version: 2.2 + name: dummy + version: 0.13.0.0 + build-type: Simple -common foo - build-depends: bar - other-modules: Other + common foo + build-depends: bar + other-modules: Other -library - Import: foo - build-depends: foo < 1 && >0.7, quux < 1 - exposed-modules: Foo -|] + library + Import: foo + build-depends: foo < 1 && >0.7, quux < 1 + exposed-modules: Foo + """ caseRenameDependency1 :: TestTree caseRenameDependency1 = @@ -516,43 +515,43 @@ , cnfRenameTo = "relude" } , crtOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - relude >=4.15 && <5, - base-foo, - foo-base + library + build-depends: + relude >=4.15 && <5, + base-foo, + foo-base -benchmark foo - type: exitcode-stdio-1.0 - main-is: Main - build-depends: base -|] + benchmark foo + type: exitcode-stdio-1.0 + main-is: Main + build-depends: base + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base >=4.15 && <5, - base-foo, - foo-base + library + build-depends: + base >=4.15 && <5, + base-foo, + foo-base -benchmark foo - type: exitcode-stdio-1.0 - main-is: Main - build-depends: base -|] + benchmark foo + type: exitcode-stdio-1.0 + main-is: Main + build-depends: base + """ caseRenameDependency2 :: TestTree caseRenameDependency2 = @@ -569,29 +568,29 @@ , cnfRenameTo = "relude" } , crtOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - relude>=4, relude<4, relude==4.9.0.0, relude^>=4.0, relude(>4 && <5) -|] + library + build-depends: + relude>=4, relude<4, relude==4.9.0.0, relude^>=4.0, relude(>4 && <5) + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - build-depends: - base>=4, base<4, base==4.9.0.0, base^>=4.0, base(>4 && <5) -|] + library + build-depends: + base>=4, base<4, base==4.9.0.0, base^>=4.0, base(>4 && <5) + """ caseRenameExposedModule1 :: TestTree caseRenameExposedModule1 = @@ -608,38 +607,81 @@ , cnfRenameTo = "Data.Quux" } , crtOutput = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - exposed-modules: Data.Quux, Data.Foo.Bar, Data.Foo.Baz + library + exposed-modules: Data.Quux, Data.Foo.Bar, Data.Foo.Baz -benchmark foo - type: exitcode-stdio-1.0 - main-is: Main - exposed-modules: Data.Foo -|] + benchmark foo + type: exitcode-stdio-1.0 + main-is: Main + exposed-modules: Data.Foo + """ } where inContents = - [s| -name: dummy -version: 0.13.0.0 -cabal-version: 2.0 -build-type: Simple + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple -library - exposed-modules: Data.Foo, Data.Foo.Bar, Data.Foo.Baz + library + exposed-modules: Data.Foo, Data.Foo.Bar, Data.Foo.Baz -benchmark foo - type: exitcode-stdio-1.0 - main-is: Main - exposed-modules: Data.Foo -|] + benchmark foo + type: exitcode-stdio-1.0 + main-is: Main + exposed-modules: Data.Foo + """ +caseRenameExposedModule2 :: TestTree +caseRenameExposedModule2 = + mkRenameTest $ + CabalRenameTest + { crtName = "rename exposed module with comments" + , crtConfig = + RenameConfig + { cnfComponent = Right $ CLibName LMainLibName + , cnfTargetField = ExposedModules + , cnfFields = parseCabalFileOrError inContents + , cnfOrigContents = inContents + , cnfRenameFrom = "Data.Foo" + , cnfRenameTo = "Data.Quux" + } + , crtOutput = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + exposed-modules: + -- Data.Foo as a comment + Data.Quux + -- Data.Foo again + """ + } + where + inContents = + """ + name: dummy + version: 0.13.0.0 + cabal-version: 2.0 + build-type: Simple + + library + exposed-modules: + -- Data.Foo as a comment + Data.Foo + -- Data.Foo again + """ + prettyDiff :: [Diff String] -> String prettyDiff = unlines @@ -673,4 +715,5 @@ , caseRenameDependency1 , caseRenameDependency2 , caseRenameExposedModule1 + , caseRenameExposedModule2 ]